mirror of
https://github.com/sfilippone/amg4psblas.git
synced 2026-10-06 22:55:12 +00:00
Compare commits
66
Commits
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
8f259367de | ||
|
|
15d1386b73 | ||
|
|
14d24b1d7c | ||
|
|
92425e2478 | ||
|
|
228f4e46a9 | ||
|
|
492ae602f2 | ||
|
|
3230c70308 | ||
|
|
eb99c74fae | ||
|
|
1c69b2f635 | ||
|
|
86731fe5bb | ||
|
|
7a5ba06622 | ||
|
|
d4c0428704 | ||
|
|
1a969488e3 | ||
|
|
95382fbb01 | ||
|
|
f586df1ac3 | ||
|
|
bab8a27962 | ||
|
|
28ccefa4bb | ||
|
|
3f33b2ce71 | ||
|
|
7279347055 | ||
|
|
e627667f3c | ||
|
|
1557bcc45b | ||
|
|
786abaff97 | ||
|
|
06f8f83114 | ||
|
|
43a75e3171 | ||
|
|
2bde1beda2 | ||
|
|
7d110a88d0 | ||
|
|
f915372c99 | ||
|
|
b5df1842e0 | ||
|
|
a6267d8e67 | ||
|
|
498f8bd482 | ||
|
|
7aef98fc09 | ||
|
|
31a44360a4 | ||
|
|
83a668c1e0 | ||
|
|
c162633845 | ||
|
|
547c4f3a60 | ||
|
|
92766e743a | ||
|
|
212892e84a | ||
|
|
f9c0eec453 | ||
|
|
387d6bef74 | ||
|
|
d6550abc70 | ||
|
|
d95341b45a | ||
|
|
7da64944b5 | ||
|
|
daaa06e486 | ||
|
|
5ee819592f | ||
|
|
5408e16a4a | ||
|
|
372ef708e0 | ||
|
|
f4e1ba97e9 | ||
|
|
e429b04600 | ||
|
|
6c12de02e8 | ||
|
|
0cb2c1c0c6 | ||
|
|
7c153de54a | ||
|
|
00cf38906a | ||
|
|
23cf86a797 | ||
|
|
91bea72cfe | ||
|
|
9a36a321f2 | ||
|
|
60d722ec53 | ||
|
|
1b8aa1618e | ||
|
|
154e88cd69 | ||
|
|
cf93042e42 | ||
|
|
ecaea5b794 | ||
|
|
3a42a2597c | ||
|
|
fcf48ee614 | ||
|
|
4c19edb2f9 | ||
|
|
c7c02bf7c0 | ||
|
|
b7edff0848 | ||
|
|
6214a918f1 |
+180
-21
@@ -1,5 +1,5 @@
|
||||
cmake_minimum_required(VERSION 3.10)
|
||||
project(amg4psblas VERSION 1.0 LANGUAGES C Fortran)
|
||||
project(amg4psblas VERSION 1.0 LANGUAGES C CXX Fortran)
|
||||
|
||||
|
||||
set(CMAKE_MODULE_PATH "${CMAKE_CURRENT_LIST_DIR}/cmake")
|
||||
@@ -21,6 +21,10 @@ 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})
|
||||
|
||||
@@ -30,6 +34,19 @@ 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}")
|
||||
@@ -39,7 +56,7 @@ set(LIBDIR "${PSBLAS_INSTALL_DIR}/${PSB_CMAKE_INSTALL_LIBDIR}")
|
||||
|
||||
|
||||
# Include directories for the project
|
||||
include_directories(${PSBLAS_INSTALL_DIR})
|
||||
include_directories(${PSBLAS_INSTALL_DIR} ${MPI_INCLUDE_PATH} )
|
||||
|
||||
|
||||
# Include directories for the Fortran compiler
|
||||
@@ -142,7 +159,7 @@ write_basic_package_version_file(
|
||||
COMPATIBILITY SameMajorVersion
|
||||
)
|
||||
|
||||
configure_file("${CMAKE_SOURCE_DIR}/cmake/pkg/${CMAKE_PROJECT_NAME}Config.cmake.in"
|
||||
configure_file("${CMAKE_SOURCE_DIR}/cmake/${CMAKE_PROJECT_NAME}Config.cmake.in"
|
||||
"${CMAKE_CURRENT_BINARY_DIR}/CMakeFiles/${CMAKE_PROJECT_NAME}Config.cmake" @ONLY)
|
||||
|
||||
install(
|
||||
@@ -177,6 +194,80 @@ add_custom_target(check COMMAND ${CMAKE_CTEST_COMMAND} --output-on-failure)
|
||||
#----------------------------------
|
||||
# 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)
|
||||
@@ -184,6 +275,34 @@ if(MPI_FOUND)
|
||||
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()
|
||||
|
||||
|
||||
@@ -205,8 +324,11 @@ configure_file(
|
||||
# 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}")
|
||||
|
||||
|
||||
|
||||
@@ -215,19 +337,29 @@ include(${CMAKE_CURRENT_LIST_DIR}/amgprec/CMakeLists.txt) # include amgprec_sou
|
||||
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) #TODO check actual libraries needed
|
||||
psblas::util psblas::linsolve psblas::prec psblas::ext psblas::cbind psblas::base
|
||||
#${MPI_C_LIBRARIES}
|
||||
) #TODO check actual libraries needed
|
||||
|
||||
add_library(amgprec ${amgprec_source_files} $<TARGET_OBJECTS:amgprec_C>)
|
||||
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 psb_amgprec
|
||||
OUTPUT_NAME amg_prec
|
||||
LINKER_LANGUAGE Fortran
|
||||
)
|
||||
|
||||
@@ -243,7 +375,9 @@ 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) #TODO check actual libraries needed
|
||||
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
|
||||
|
||||
|
||||
|
||||
@@ -260,20 +394,20 @@ foreach(path IN LISTS amgcbind_header_C_files)
|
||||
endforeach()
|
||||
|
||||
|
||||
add_library(amgcbind_C OBJECT ${amgprec_source_C_files})
|
||||
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 ${amgprec_source_files} $<TARGET_OBJECTS:amgcbind_C>)
|
||||
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 psb_amgcbind
|
||||
OUTPUT_NAME amg_cbind
|
||||
LINKER_LANGUAGE Fortran
|
||||
)
|
||||
|
||||
@@ -354,25 +488,50 @@ message(STATUS "install directory is ${CMAKE_INSTALL_LIBDIR};;;")
|
||||
# FILE "${CMAKE_CURRENT_BINARY_DIR}/amg4psblasTargets.cmake"
|
||||
# NAMESPACE psblas::
|
||||
#)
|
||||
export(
|
||||
EXPORT ${CMAKE_PROJECT_NAME}-targets
|
||||
FILE "${CMAKE_CURRENT_BINARY_DIR}/psblasTargets.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}::
|
||||
)
|
||||
|
||||
#export(
|
||||
# EXPORT ${CMAKE_PROJECT_NAME}-targets
|
||||
# FILE "${CMAKE_CURRENT_BINARY_DIR}/${CMAKE_PROJECT_NAME}Targets.cmake"
|
||||
# NAMESPACE ${CMAKE_PROJECT_NAME}::
|
||||
#)
|
||||
|
||||
|
||||
|
||||
|
||||
# Optionally, you can install the headers
|
||||
#install(DIRECTORY include/
|
||||
# DESTINATION include
|
||||
#)
|
||||
# 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")
|
||||
|
||||
|
||||
|
||||
|
||||
@@ -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,10 +16,10 @@ 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: all
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -77,6 +161,6 @@ In the European project “Energy oriented Center of Excellence: toward exascale
|
||||
**Contributors** (_roughly reverse cronological order_):
|
||||
|
||||
- Luca Pepè Sciarria
|
||||
- Andea Di Iorio
|
||||
- Ambra Abdullahi Hassan
|
||||
- Andrea Di Iorio
|
||||
- Ambra Abdullahi Hassan
|
||||
- Alfredo Buttari
|
||||
|
||||
@@ -875,6 +875,33 @@ list(APPEND AMG_amgprec_source_C_files impl/amg_dslud_interface.c)
|
||||
list(APPEND AMG_amgprec_source_C_files impl/amg_zumf_interface.c)
|
||||
list(APPEND AMG_amgprec_source_C_files impl/amg_zslud_interface.c)
|
||||
|
||||
|
||||
set(AMG_amgprec_source_CPP_files
|
||||
impl/aggregator/computeCandidateMate.cpp
|
||||
impl/aggregator/processExposedVertex.cpp
|
||||
impl/aggregator/processMatchedVertices.cpp
|
||||
impl/aggregator/algoDistEdgeApproxDomEdgesLinearSearchMesgBndlSmallMateCMP.cpp
|
||||
impl/aggregator/processCrossEdge.cpp
|
||||
impl/aggregator/findOwnerOfGhost.cpp
|
||||
impl/aggregator/MatchBoxPC.cpp
|
||||
impl/aggregator/queueTransfer.cpp
|
||||
impl/aggregator/clean.cpp
|
||||
impl/aggregator/algoDistEdgeApproxDomEdgesLinearSearchMesgBndlSmallMateC.cpp
|
||||
impl/aggregator/extractUChunk.cpp
|
||||
impl/aggregator/processMatchedVerticesAndSendMessages.cpp
|
||||
impl/aggregator/sendBundledMessages.cpp
|
||||
impl/aggregator/initialize.cpp
|
||||
impl/aggregator/isAlreadyMatched.cpp
|
||||
impl/aggregator/processMessages.cpp
|
||||
impl/aggregator/parallelComputeCandidateMateB.cpp
|
||||
)
|
||||
|
||||
|
||||
foreach(file IN LISTS AMG_amgprec_source_C_files)
|
||||
list(APPEND amgprec_source_C_files ${CMAKE_CURRENT_LIST_DIR}/${file})
|
||||
endforeach()
|
||||
|
||||
|
||||
foreach(file IN LISTS AMG_amgprec_source_CPP_files)
|
||||
list(APPEND amgprec_source_CPP_files ${CMAKE_CURRENT_LIST_DIR}/${file})
|
||||
endforeach()
|
||||
|
||||
+9
-10
@@ -58,23 +58,22 @@ MODOBJS=amg_base_prec_type.o amg_prec_type.o amg_prec_mod.o \
|
||||
$(SMODOBJS) $(DMODOBJS) $(CMODOBJS) $(ZMODOBJS)
|
||||
|
||||
|
||||
OBJS=$(MODOBJS)
|
||||
|
||||
LOCAL_MODS=$(MODOBJS:.o=$(.mod))
|
||||
LOCAL_MODS=$(MODOBJS:.o=$(.mod)) amg_c_l1_diag_solver$(.mod) amg_s_l1_diag_solver$(.mod) \
|
||||
amg_d_l1_diag_solver$(.mod) amg_z_l1_diag_solver$(.mod)
|
||||
LIBNAME=libamg_prec.a
|
||||
|
||||
all: objs impld
|
||||
all: mods objs impld
|
||||
|
||||
objs: $(OBJS)
|
||||
mods: $(MODOBJS)
|
||||
/bin/cp -p amg_const.h amg_config.h $(INCDIR)
|
||||
/bin/cp -p *$(.mod) $(MODDIR)
|
||||
|
||||
impld: objs
|
||||
objs: mods impld
|
||||
impld: mods
|
||||
cd impl && $(MAKE)
|
||||
|
||||
lib: $(OBJS) impld
|
||||
lib: objs
|
||||
cd impl && $(MAKE) lib
|
||||
$(AR) $(HERE)/$(LIBNAME) $(OBJS)
|
||||
$(AR) $(HERE)/$(LIBNAME) $(MODOBJS)
|
||||
$(RANLIB) $(HERE)/$(LIBNAME)
|
||||
/bin/cp -p $(HERE)/$(LIBNAME) $(LIBDIR)
|
||||
|
||||
@@ -221,7 +220,7 @@ veryclean: clean
|
||||
/bin/rm -f $(LIBNAME)
|
||||
|
||||
clean: implclean
|
||||
/bin/rm -f $(OBJS) $(LOCAL_MODS) *$(.mod)
|
||||
/bin/rm -f $(MODOBJS) $(LOCAL_MODS) *$(.mod)
|
||||
|
||||
implclean:
|
||||
cd impl && $(MAKE) clean
|
||||
|
||||
+261
-205
@@ -63,9 +63,9 @@ module amg_c_slu_solver
|
||||
type(c_ptr) :: lufactors=c_null_ptr
|
||||
integer(c_long_long) :: symbsize=0, numsize=0
|
||||
contains
|
||||
procedure, pass(sv) :: build => c_slu_solver_bld
|
||||
procedure, pass(sv) :: apply_a => c_slu_solver_apply
|
||||
procedure, pass(sv) :: apply_v => c_slu_solver_apply_vect
|
||||
procedure, pass(sv) :: build => amg_c_slu_solver_bld
|
||||
procedure, pass(sv) :: apply_a => amg_c_slu_solver_apply
|
||||
procedure, pass(sv) :: apply_v => amg_c_slu_solver_apply_vect
|
||||
procedure, pass(sv) :: free => c_slu_solver_free
|
||||
procedure, pass(sv) :: clear_data => c_slu_solver_clear_data
|
||||
procedure, pass(sv) :: descr => c_slu_solver_descr
|
||||
@@ -76,9 +76,8 @@ module amg_c_slu_solver
|
||||
end type amg_c_slu_solver_type
|
||||
|
||||
|
||||
private :: c_slu_solver_bld, c_slu_solver_apply, &
|
||||
& c_slu_solver_free, c_slu_solver_descr, &
|
||||
& c_slu_solver_sizeof, c_slu_solver_apply_vect, &
|
||||
private :: c_slu_solver_free, c_slu_solver_descr, &
|
||||
& c_slu_solver_sizeof, &
|
||||
& c_slu_solver_get_fmt, c_slu_solver_get_id, &
|
||||
& c_slu_solver_clear_data
|
||||
private :: c_slu_solver_finalize
|
||||
@@ -118,207 +117,264 @@ module amg_c_slu_solver
|
||||
end function amg_cslu_free
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_c_slu_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
|
||||
use psb_base_mod
|
||||
import amg_c_slu_solver_type
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
type(psb_cspmat_type), intent(in), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_c_slu_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
type(psb_cspmat_type), intent(in), target, optional :: b
|
||||
class(psb_c_base_sparse_mat), intent(in), optional :: amold
|
||||
class(psb_c_base_vect_type), intent(in), optional :: vmold
|
||||
class(psb_i_base_vect_type), intent(in), optional :: imold
|
||||
end subroutine amg_c_slu_solver_bld
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_c_slu_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
|
||||
& trans,work,wv,info,init,initu)
|
||||
use psb_base_mod
|
||||
import amg_c_slu_solver_type
|
||||
implicit none
|
||||
type(psb_desc_type), intent(in) :: desc_data
|
||||
class(amg_c_slu_solver_type), intent(inout) :: sv
|
||||
type(psb_c_vect_type),intent(inout) :: x
|
||||
type(psb_c_vect_type),intent(inout) :: y
|
||||
complex(psb_spk_),intent(in) :: alpha,beta
|
||||
character(len=1),intent(in) :: trans
|
||||
complex(psb_spk_),target, intent(inout) :: work(:)
|
||||
type(psb_c_vect_type),intent(inout) :: wv(:)
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character, intent(in), optional :: init
|
||||
type(psb_c_vect_type),intent(inout), optional :: initu
|
||||
end subroutine amg_c_slu_solver_apply_vect
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_c_slu_solver_apply(alpha,sv,x,beta,y,desc_data,&
|
||||
& trans,work,info,init,initu)
|
||||
use psb_base_mod
|
||||
import amg_c_slu_solver_type
|
||||
implicit none
|
||||
type(psb_desc_type), intent(in) :: desc_data
|
||||
class(amg_c_slu_solver_type), intent(inout) :: sv
|
||||
complex(psb_spk_),intent(inout) :: x(:)
|
||||
complex(psb_spk_),intent(inout) :: y(:)
|
||||
complex(psb_spk_),intent(in) :: alpha,beta
|
||||
character(len=1),intent(in) :: trans
|
||||
complex(psb_spk_),target, intent(inout) :: work(:)
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character, intent(in), optional :: init
|
||||
complex(psb_spk_),intent(inout), optional :: initu(:)
|
||||
end subroutine amg_c_slu_solver_apply
|
||||
end interface
|
||||
|
||||
contains
|
||||
|
||||
subroutine c_slu_solver_apply(alpha,sv,x,beta,y,desc_data,&
|
||||
& trans,work,info,init,initu)
|
||||
use psb_base_mod
|
||||
implicit none
|
||||
type(psb_desc_type), intent(in) :: desc_data
|
||||
class(amg_c_slu_solver_type), intent(inout) :: sv
|
||||
complex(psb_spk_),intent(inout) :: x(:)
|
||||
complex(psb_spk_),intent(inout) :: y(:)
|
||||
complex(psb_spk_),intent(in) :: alpha,beta
|
||||
character(len=1),intent(in) :: trans
|
||||
complex(psb_spk_),target, intent(inout) :: work(:)
|
||||
integer, intent(out) :: info
|
||||
character, intent(in), optional :: init
|
||||
complex(psb_spk_),intent(inout), optional :: initu(:)
|
||||
|
||||
integer :: n_row,n_col
|
||||
complex(psb_spk_), pointer :: ww(:)
|
||||
type(psb_ctxt_type) :: ctxt
|
||||
integer :: np,me,i, err_act
|
||||
character :: trans_
|
||||
character(len=20) :: name='c_slu_solver_apply'
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
info = psb_success_
|
||||
|
||||
trans_ = psb_toupper(trans)
|
||||
select case(trans_)
|
||||
case('N')
|
||||
case('T','C')
|
||||
case default
|
||||
call psb_errpush(psb_err_iarg_invalid_i_,name)
|
||||
goto 9999
|
||||
end select
|
||||
!
|
||||
! For non-iterative solvers, init and initu are ignored.
|
||||
!
|
||||
|
||||
n_row = desc_data%get_local_rows()
|
||||
n_col = desc_data%get_local_cols()
|
||||
|
||||
if (n_col <= size(work)) then
|
||||
ww => work(1:n_col)
|
||||
else
|
||||
allocate(ww(n_col),stat=info)
|
||||
if (info /= psb_success_) then
|
||||
info=psb_err_alloc_request_
|
||||
call psb_errpush(info,name,i_err=(/n_col,0,0,0,0/),&
|
||||
& a_err='complex(psb_spk_)')
|
||||
goto 9999
|
||||
end if
|
||||
endif
|
||||
|
||||
ww(1:n_row) = x(1:n_row)
|
||||
select case(trans_)
|
||||
case('N')
|
||||
info = amg_cslu_solve(0,n_row,1,ww,n_row,sv%lufactors)
|
||||
case('T')
|
||||
info = amg_cslu_solve(1,n_row,1,ww,n_row,sv%lufactors)
|
||||
case('C')
|
||||
info = amg_cslu_solve(2,n_row,1,ww,n_row,sv%lufactors)
|
||||
case default
|
||||
call psb_errpush(psb_err_internal_error_, &
|
||||
& name,a_err='Invalid TRANS in ILU subsolve')
|
||||
goto 9999
|
||||
end select
|
||||
|
||||
if (info == psb_success_) &
|
||||
& call psb_geaxpby(alpha,ww,beta,y,desc_data,info)
|
||||
|
||||
|
||||
if (info /= psb_success_) then
|
||||
call psb_errpush(psb_err_internal_error_,&
|
||||
& name,a_err='Error in subsolve')
|
||||
goto 9999
|
||||
endif
|
||||
|
||||
if (n_col > size(work)) then
|
||||
deallocate(ww)
|
||||
endif
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
|
||||
end subroutine c_slu_solver_apply
|
||||
|
||||
subroutine c_slu_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
|
||||
& trans,work,wv,info,init,initu)
|
||||
use psb_base_mod
|
||||
implicit none
|
||||
type(psb_desc_type), intent(in) :: desc_data
|
||||
class(amg_c_slu_solver_type), intent(inout) :: sv
|
||||
type(psb_c_vect_type),intent(inout) :: x
|
||||
type(psb_c_vect_type),intent(inout) :: y
|
||||
complex(psb_spk_),intent(in) :: alpha,beta
|
||||
character(len=1),intent(in) :: trans
|
||||
complex(psb_spk_),target, intent(inout) :: work(:)
|
||||
type(psb_c_vect_type),intent(inout) :: wv(:)
|
||||
integer, intent(out) :: info
|
||||
character, intent(in), optional :: init
|
||||
type(psb_c_vect_type),intent(inout), optional :: initu
|
||||
|
||||
integer :: err_act
|
||||
character(len=20) :: name='c_slu_solver_apply_vect'
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
info = psb_success_
|
||||
!
|
||||
! For non-iterative solvers, init and initu are ignored.
|
||||
!
|
||||
|
||||
call x%v%sync()
|
||||
call y%v%sync()
|
||||
call sv%apply(alpha,x%v%v,beta,y%v%v,desc_data,trans,work,info)
|
||||
call y%v%set_host()
|
||||
if (info /= 0) goto 9999
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
|
||||
end subroutine c_slu_solver_apply_vect
|
||||
|
||||
subroutine c_slu_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
|
||||
|
||||
use psb_base_mod
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
type(psb_cspmat_type), intent(in), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_c_slu_solver_type), intent(inout) :: sv
|
||||
integer, intent(out) :: info
|
||||
type(psb_cspmat_type), intent(in), target, optional :: b
|
||||
class(psb_c_base_sparse_mat), intent(in), optional :: amold
|
||||
class(psb_c_base_vect_type), intent(in), optional :: vmold
|
||||
class(psb_i_base_vect_type), intent(in), optional :: imold
|
||||
! Local variables
|
||||
type(psb_cspmat_type) :: atmp
|
||||
type(psb_c_csc_sparse_mat) :: acsc
|
||||
type(psb_c_coo_sparse_mat) :: acoo
|
||||
integer :: n_row,n_col, nrow_a, nztota
|
||||
type(psb_ctxt_type) :: ctxt
|
||||
integer :: np,me,i, err_act, debug_unit, debug_level
|
||||
character(len=20) :: name='c_slu_solver_bld', ch_err
|
||||
|
||||
info=psb_success_
|
||||
call psb_erractionsave(err_act)
|
||||
debug_unit = psb_get_debug_unit()
|
||||
debug_level = psb_get_debug_level()
|
||||
ctxt = desc_a%get_context()
|
||||
call psb_info(ctxt, me, np)
|
||||
if (debug_level >= psb_debug_outer_) &
|
||||
& write(debug_unit,*) me,' ',trim(name),' start'
|
||||
|
||||
|
||||
n_row = desc_a%get_local_rows()
|
||||
n_col = desc_a%get_local_cols()
|
||||
|
||||
|
||||
call a%cscnv(atmp,info,type='coo')
|
||||
call psb_rwextd(n_row,atmp,info,b=b)
|
||||
call atmp%cscnv(info,type='coo',dupl=psb_dupl_add_)
|
||||
nrow_a = atmp%get_nrows()
|
||||
call atmp%a%csclip(acoo,info,jmax=nrow_a)
|
||||
call acsc%mv_from_coo(acoo,info)
|
||||
nztota = acsc%get_nzeros()
|
||||
! Fix the entries to call C-base SuperLU
|
||||
acsc%ia(:) = acsc%ia(:) - 1
|
||||
acsc%icp(:) = acsc%icp(:) - 1
|
||||
info = amg_cslu_fact(nrow_a,nztota,acsc%val,&
|
||||
& acsc%icp,acsc%ia,sv%lufactors)
|
||||
|
||||
if (info /= psb_success_) then
|
||||
info=psb_err_from_subroutine_
|
||||
ch_err='amg_cslu_fact'
|
||||
call psb_errpush(info,name,a_err=ch_err)
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
call acsc%free()
|
||||
call atmp%free()
|
||||
|
||||
if (debug_level >= psb_debug_outer_) &
|
||||
& write(debug_unit,*) me,' ',trim(name),' end'
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
end subroutine c_slu_solver_bld
|
||||
!!$ subroutine c_slu_solver_apply(alpha,sv,x,beta,y,desc_data,&
|
||||
!!$ & trans,work,info,init,initu)
|
||||
!!$ use psb_base_mod
|
||||
!!$ implicit none
|
||||
!!$ type(psb_desc_type), intent(in) :: desc_data
|
||||
!!$ class(amg_c_slu_solver_type), intent(inout) :: sv
|
||||
!!$ complex(psb_spk_),intent(inout) :: x(:)
|
||||
!!$ complex(psb_spk_),intent(inout) :: y(:)
|
||||
!!$ complex(psb_spk_),intent(in) :: alpha,beta
|
||||
!!$ character(len=1),intent(in) :: trans
|
||||
!!$ complex(psb_spk_),target, intent(inout) :: work(:)
|
||||
!!$ integer, intent(out) :: info
|
||||
!!$ character, intent(in), optional :: init
|
||||
!!$ complex(psb_spk_),intent(inout), optional :: initu(:)
|
||||
!!$
|
||||
!!$ integer :: n_row,n_col
|
||||
!!$ complex(psb_spk_), pointer :: ww(:)
|
||||
!!$ type(psb_ctxt_type) :: ctxt
|
||||
!!$ integer :: np,me,i, err_act
|
||||
!!$ character :: trans_
|
||||
!!$ character(len=20) :: name='c_slu_solver_apply'
|
||||
!!$
|
||||
!!$ call psb_erractionsave(err_act)
|
||||
!!$
|
||||
!!$ info = psb_success_
|
||||
!!$
|
||||
!!$ trans_ = psb_toupper(trans)
|
||||
!!$ select case(trans_)
|
||||
!!$ case('N')
|
||||
!!$ case('T','C')
|
||||
!!$ case default
|
||||
!!$ call psb_errpush(psb_err_iarg_invalid_i_,name)
|
||||
!!$ goto 9999
|
||||
!!$ end select
|
||||
!!$ !
|
||||
!!$ ! For non-iterative solvers, init and initu are ignored.
|
||||
!!$ !
|
||||
!!$
|
||||
!!$ n_row = desc_data%get_local_rows()
|
||||
!!$ n_col = desc_data%get_local_cols()
|
||||
!!$
|
||||
!!$ if (n_col <= size(work)) then
|
||||
!!$ ww => work(1:n_col)
|
||||
!!$ else
|
||||
!!$ allocate(ww(n_col),stat=info)
|
||||
!!$ if (info /= psb_success_) then
|
||||
!!$ info=psb_err_alloc_request_
|
||||
!!$ call psb_errpush(info,name,i_err=(/n_col,0,0,0,0/),&
|
||||
!!$ & a_err='complex(psb_spk_)')
|
||||
!!$ goto 9999
|
||||
!!$ end if
|
||||
!!$ endif
|
||||
!!$
|
||||
!!$ ww(1:n_row) = x(1:n_row)
|
||||
!!$ select case(trans_)
|
||||
!!$ case('N')
|
||||
!!$ info = amg_cslu_solve(0,n_row,1,ww,n_row,sv%lufactors)
|
||||
!!$ case('T')
|
||||
!!$ info = amg_cslu_solve(1,n_row,1,ww,n_row,sv%lufactors)
|
||||
!!$ case('C')
|
||||
!!$ info = amg_cslu_solve(2,n_row,1,ww,n_row,sv%lufactors)
|
||||
!!$ case default
|
||||
!!$ call psb_errpush(psb_err_internal_error_, &
|
||||
!!$ & name,a_err='Invalid TRANS in ILU subsolve')
|
||||
!!$ goto 9999
|
||||
!!$ end select
|
||||
!!$
|
||||
!!$ if (info == psb_success_) &
|
||||
!!$ & call psb_geaxpby(alpha,ww,beta,y,desc_data,info)
|
||||
!!$
|
||||
!!$
|
||||
!!$ if (info /= psb_success_) then
|
||||
!!$ call psb_errpush(psb_err_internal_error_,&
|
||||
!!$ & name,a_err='Error in subsolve')
|
||||
!!$ goto 9999
|
||||
!!$ endif
|
||||
!!$
|
||||
!!$ if (n_col > size(work)) then
|
||||
!!$ deallocate(ww)
|
||||
!!$ endif
|
||||
!!$
|
||||
!!$ call psb_erractionrestore(err_act)
|
||||
!!$ return
|
||||
!!$
|
||||
!!$9999 call psb_error_handler(err_act)
|
||||
!!$ return
|
||||
!!$
|
||||
!!$ end subroutine c_slu_solver_apply
|
||||
!!$
|
||||
!!$ subroutine c_slu_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
|
||||
!!$ & trans,work,wv,info,init,initu)
|
||||
!!$ use psb_base_mod
|
||||
!!$ implicit none
|
||||
!!$ type(psb_desc_type), intent(in) :: desc_data
|
||||
!!$ class(amg_c_slu_solver_type), intent(inout) :: sv
|
||||
!!$ type(psb_c_vect_type),intent(inout) :: x
|
||||
!!$ type(psb_c_vect_type),intent(inout) :: y
|
||||
!!$ complex(psb_spk_),intent(in) :: alpha,beta
|
||||
!!$ character(len=1),intent(in) :: trans
|
||||
!!$ complex(psb_spk_),target, intent(inout) :: work(:)
|
||||
!!$ type(psb_c_vect_type),intent(inout) :: wv(:)
|
||||
!!$ integer, intent(out) :: info
|
||||
!!$ character, intent(in), optional :: init
|
||||
!!$ type(psb_c_vect_type),intent(inout), optional :: initu
|
||||
!!$
|
||||
!!$ integer :: err_act
|
||||
!!$ character(len=20) :: name='c_slu_solver_apply_vect'
|
||||
!!$
|
||||
!!$ call psb_erractionsave(err_act)
|
||||
!!$
|
||||
!!$ info = psb_success_
|
||||
!!$ !
|
||||
!!$ ! For non-iterative solvers, init and initu are ignored.
|
||||
!!$ !
|
||||
!!$
|
||||
!!$ call x%v%sync()
|
||||
!!$ call y%v%sync()
|
||||
!!$ call sv%apply(alpha,x%v%v,beta,y%v%v,desc_data,trans,work,info)
|
||||
!!$ call y%v%set_host()
|
||||
!!$ if (info /= 0) goto 9999
|
||||
!!$
|
||||
!!$ call psb_erractionrestore(err_act)
|
||||
!!$ return
|
||||
!!$
|
||||
!!$9999 call psb_error_handler(err_act)
|
||||
!!$ return
|
||||
!!$
|
||||
!!$ end subroutine c_slu_solver_apply_vect
|
||||
!!$
|
||||
!!$ subroutine c_slu_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
|
||||
!!$
|
||||
!!$ use psb_base_mod
|
||||
!!$
|
||||
!!$ Implicit None
|
||||
!!$
|
||||
!!$ ! Arguments
|
||||
!!$ type(psb_cspmat_type), intent(in), target :: a
|
||||
!!$ Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
!!$ class(amg_c_slu_solver_type), intent(inout) :: sv
|
||||
!!$ integer, intent(out) :: info
|
||||
!!$ type(psb_cspmat_type), intent(in), target, optional :: b
|
||||
!!$ class(psb_c_base_sparse_mat), intent(in), optional :: amold
|
||||
!!$ class(psb_c_base_vect_type), intent(in), optional :: vmold
|
||||
!!$ class(psb_i_base_vect_type), intent(in), optional :: imold
|
||||
!!$ ! Local variables
|
||||
!!$ type(psb_cspmat_type) :: atmp
|
||||
!!$ type(psb_c_csc_sparse_mat) :: acsc
|
||||
!!$ type(psb_c_coo_sparse_mat) :: acoo
|
||||
!!$ integer :: n_row,n_col, nrow_a, nztota
|
||||
!!$ type(psb_ctxt_type) :: ctxt
|
||||
!!$ integer :: np,me,i, err_act, debug_unit, debug_level
|
||||
!!$ character(len=20) :: name='c_slu_solver_bld', ch_err
|
||||
!!$
|
||||
!!$ info=psb_success_
|
||||
!!$ call psb_erractionsave(err_act)
|
||||
!!$ debug_unit = psb_get_debug_unit()
|
||||
!!$ debug_level = psb_get_debug_level()
|
||||
!!$ ctxt = desc_a%get_context()
|
||||
!!$ call psb_info(ctxt, me, np)
|
||||
!!$ if (debug_level >= psb_debug_outer_) &
|
||||
!!$ & write(debug_unit,*) me,' ',trim(name),' start'
|
||||
!!$
|
||||
!!$
|
||||
!!$ n_row = desc_a%get_local_rows()
|
||||
!!$ n_col = desc_a%get_local_cols()
|
||||
!!$
|
||||
!!$
|
||||
!!$ call a%cscnv(atmp,info,type='coo')
|
||||
!!$ call psb_rwextd(n_row,atmp,info,b=b)
|
||||
!!$ call atmp%cscnv(info,type='coo',dupl=psb_dupl_add_)
|
||||
!!$ nrow_a = atmp%get_nrows()
|
||||
!!$ call atmp%a%csclip(acoo,info,jmax=nrow_a)
|
||||
!!$ call acsc%mv_from_coo(acoo,info)
|
||||
!!$ nztota = acsc%get_nzeros()
|
||||
!!$ ! Fix the entries to call C-base SuperLU
|
||||
!!$ acsc%ia(:) = acsc%ia(:) - 1
|
||||
!!$ acsc%icp(:) = acsc%icp(:) - 1
|
||||
!!$ info = amg_cslu_fact(nrow_a,nztota,acsc%val,&
|
||||
!!$ & acsc%icp,acsc%ia,sv%lufactors)
|
||||
!!$
|
||||
!!$ if (info /= psb_success_) then
|
||||
!!$ info=psb_err_from_subroutine_
|
||||
!!$ ch_err='amg_cslu_fact'
|
||||
!!$ call psb_errpush(info,name,a_err=ch_err)
|
||||
!!$ goto 9999
|
||||
!!$ end if
|
||||
!!$
|
||||
!!$ call acsc%free()
|
||||
!!$ call atmp%free()
|
||||
!!$
|
||||
!!$ if (debug_level >= psb_debug_outer_) &
|
||||
!!$ & write(debug_unit,*) me,' ',trim(name),' end'
|
||||
!!$
|
||||
!!$ call psb_erractionrestore(err_act)
|
||||
!!$ return
|
||||
!!$
|
||||
!!$9999 call psb_error_handler(err_act)
|
||||
!!$ return
|
||||
!!$ end subroutine c_slu_solver_bld
|
||||
|
||||
subroutine c_slu_solver_free(sv,info)
|
||||
|
||||
|
||||
+261
-205
@@ -63,9 +63,9 @@ module amg_d_slu_solver
|
||||
type(c_ptr) :: lufactors=c_null_ptr
|
||||
integer(c_long_long) :: symbsize=0, numsize=0
|
||||
contains
|
||||
procedure, pass(sv) :: build => d_slu_solver_bld
|
||||
procedure, pass(sv) :: apply_a => d_slu_solver_apply
|
||||
procedure, pass(sv) :: apply_v => d_slu_solver_apply_vect
|
||||
procedure, pass(sv) :: build => amg_d_slu_solver_bld
|
||||
procedure, pass(sv) :: apply_a => amg_d_slu_solver_apply
|
||||
procedure, pass(sv) :: apply_v => amg_d_slu_solver_apply_vect
|
||||
procedure, pass(sv) :: free => d_slu_solver_free
|
||||
procedure, pass(sv) :: clear_data => d_slu_solver_clear_data
|
||||
procedure, pass(sv) :: descr => d_slu_solver_descr
|
||||
@@ -76,9 +76,8 @@ module amg_d_slu_solver
|
||||
end type amg_d_slu_solver_type
|
||||
|
||||
|
||||
private :: d_slu_solver_bld, d_slu_solver_apply, &
|
||||
& d_slu_solver_free, d_slu_solver_descr, &
|
||||
& d_slu_solver_sizeof, d_slu_solver_apply_vect, &
|
||||
private :: d_slu_solver_free, d_slu_solver_descr, &
|
||||
& d_slu_solver_sizeof, &
|
||||
& d_slu_solver_get_fmt, d_slu_solver_get_id, &
|
||||
& d_slu_solver_clear_data
|
||||
private :: d_slu_solver_finalize
|
||||
@@ -118,207 +117,264 @@ module amg_d_slu_solver
|
||||
end function amg_dslu_free
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_d_slu_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
|
||||
use psb_base_mod
|
||||
import amg_d_slu_solver_type
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
type(psb_dspmat_type), intent(in), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_d_slu_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
type(psb_dspmat_type), intent(in), target, optional :: b
|
||||
class(psb_d_base_sparse_mat), intent(in), optional :: amold
|
||||
class(psb_d_base_vect_type), intent(in), optional :: vmold
|
||||
class(psb_i_base_vect_type), intent(in), optional :: imold
|
||||
end subroutine amg_d_slu_solver_bld
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_d_slu_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
|
||||
& trans,work,wv,info,init,initu)
|
||||
use psb_base_mod
|
||||
import amg_d_slu_solver_type
|
||||
implicit none
|
||||
type(psb_desc_type), intent(in) :: desc_data
|
||||
class(amg_d_slu_solver_type), intent(inout) :: sv
|
||||
type(psb_d_vect_type),intent(inout) :: x
|
||||
type(psb_d_vect_type),intent(inout) :: y
|
||||
real(psb_dpk_),intent(in) :: alpha,beta
|
||||
character(len=1),intent(in) :: trans
|
||||
real(psb_dpk_),target, intent(inout) :: work(:)
|
||||
type(psb_d_vect_type),intent(inout) :: wv(:)
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character, intent(in), optional :: init
|
||||
type(psb_d_vect_type),intent(inout), optional :: initu
|
||||
end subroutine amg_d_slu_solver_apply_vect
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_d_slu_solver_apply(alpha,sv,x,beta,y,desc_data,&
|
||||
& trans,work,info,init,initu)
|
||||
use psb_base_mod
|
||||
import amg_d_slu_solver_type
|
||||
implicit none
|
||||
type(psb_desc_type), intent(in) :: desc_data
|
||||
class(amg_d_slu_solver_type), intent(inout) :: sv
|
||||
real(psb_dpk_),intent(inout) :: x(:)
|
||||
real(psb_dpk_),intent(inout) :: y(:)
|
||||
real(psb_dpk_),intent(in) :: alpha,beta
|
||||
character(len=1),intent(in) :: trans
|
||||
real(psb_dpk_),target, intent(inout) :: work(:)
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character, intent(in), optional :: init
|
||||
real(psb_dpk_),intent(inout), optional :: initu(:)
|
||||
end subroutine amg_d_slu_solver_apply
|
||||
end interface
|
||||
|
||||
contains
|
||||
|
||||
subroutine d_slu_solver_apply(alpha,sv,x,beta,y,desc_data,&
|
||||
& trans,work,info,init,initu)
|
||||
use psb_base_mod
|
||||
implicit none
|
||||
type(psb_desc_type), intent(in) :: desc_data
|
||||
class(amg_d_slu_solver_type), intent(inout) :: sv
|
||||
real(psb_dpk_),intent(inout) :: x(:)
|
||||
real(psb_dpk_),intent(inout) :: y(:)
|
||||
real(psb_dpk_),intent(in) :: alpha,beta
|
||||
character(len=1),intent(in) :: trans
|
||||
real(psb_dpk_),target, intent(inout) :: work(:)
|
||||
integer, intent(out) :: info
|
||||
character, intent(in), optional :: init
|
||||
real(psb_dpk_),intent(inout), optional :: initu(:)
|
||||
|
||||
integer :: n_row,n_col
|
||||
real(psb_dpk_), pointer :: ww(:)
|
||||
type(psb_ctxt_type) :: ctxt
|
||||
integer :: np,me,i, err_act
|
||||
character :: trans_
|
||||
character(len=20) :: name='d_slu_solver_apply'
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
info = psb_success_
|
||||
|
||||
trans_ = psb_toupper(trans)
|
||||
select case(trans_)
|
||||
case('N')
|
||||
case('T','C')
|
||||
case default
|
||||
call psb_errpush(psb_err_iarg_invalid_i_,name)
|
||||
goto 9999
|
||||
end select
|
||||
!
|
||||
! For non-iterative solvers, init and initu are ignored.
|
||||
!
|
||||
|
||||
n_row = desc_data%get_local_rows()
|
||||
n_col = desc_data%get_local_cols()
|
||||
|
||||
if (n_col <= size(work)) then
|
||||
ww => work(1:n_col)
|
||||
else
|
||||
allocate(ww(n_col),stat=info)
|
||||
if (info /= psb_success_) then
|
||||
info=psb_err_alloc_request_
|
||||
call psb_errpush(info,name,i_err=(/n_col,0,0,0,0/),&
|
||||
& a_err='real(psb_dpk_)')
|
||||
goto 9999
|
||||
end if
|
||||
endif
|
||||
|
||||
ww(1:n_row) = x(1:n_row)
|
||||
select case(trans_)
|
||||
case('N')
|
||||
info = amg_dslu_solve(0,n_row,1,ww,n_row,sv%lufactors)
|
||||
case('T')
|
||||
info = amg_dslu_solve(1,n_row,1,ww,n_row,sv%lufactors)
|
||||
case('C')
|
||||
info = amg_dslu_solve(2,n_row,1,ww,n_row,sv%lufactors)
|
||||
case default
|
||||
call psb_errpush(psb_err_internal_error_, &
|
||||
& name,a_err='Invalid TRANS in ILU subsolve')
|
||||
goto 9999
|
||||
end select
|
||||
|
||||
if (info == psb_success_) &
|
||||
& call psb_geaxpby(alpha,ww,beta,y,desc_data,info)
|
||||
|
||||
|
||||
if (info /= psb_success_) then
|
||||
call psb_errpush(psb_err_internal_error_,&
|
||||
& name,a_err='Error in subsolve')
|
||||
goto 9999
|
||||
endif
|
||||
|
||||
if (n_col > size(work)) then
|
||||
deallocate(ww)
|
||||
endif
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
|
||||
end subroutine d_slu_solver_apply
|
||||
|
||||
subroutine d_slu_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
|
||||
& trans,work,wv,info,init,initu)
|
||||
use psb_base_mod
|
||||
implicit none
|
||||
type(psb_desc_type), intent(in) :: desc_data
|
||||
class(amg_d_slu_solver_type), intent(inout) :: sv
|
||||
type(psb_d_vect_type),intent(inout) :: x
|
||||
type(psb_d_vect_type),intent(inout) :: y
|
||||
real(psb_dpk_),intent(in) :: alpha,beta
|
||||
character(len=1),intent(in) :: trans
|
||||
real(psb_dpk_),target, intent(inout) :: work(:)
|
||||
type(psb_d_vect_type),intent(inout) :: wv(:)
|
||||
integer, intent(out) :: info
|
||||
character, intent(in), optional :: init
|
||||
type(psb_d_vect_type),intent(inout), optional :: initu
|
||||
|
||||
integer :: err_act
|
||||
character(len=20) :: name='d_slu_solver_apply_vect'
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
info = psb_success_
|
||||
!
|
||||
! For non-iterative solvers, init and initu are ignored.
|
||||
!
|
||||
|
||||
call x%v%sync()
|
||||
call y%v%sync()
|
||||
call sv%apply(alpha,x%v%v,beta,y%v%v,desc_data,trans,work,info)
|
||||
call y%v%set_host()
|
||||
if (info /= 0) goto 9999
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
|
||||
end subroutine d_slu_solver_apply_vect
|
||||
|
||||
subroutine d_slu_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
|
||||
|
||||
use psb_base_mod
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
type(psb_dspmat_type), intent(in), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_d_slu_solver_type), intent(inout) :: sv
|
||||
integer, intent(out) :: info
|
||||
type(psb_dspmat_type), intent(in), target, optional :: b
|
||||
class(psb_d_base_sparse_mat), intent(in), optional :: amold
|
||||
class(psb_d_base_vect_type), intent(in), optional :: vmold
|
||||
class(psb_i_base_vect_type), intent(in), optional :: imold
|
||||
! Local variables
|
||||
type(psb_dspmat_type) :: atmp
|
||||
type(psb_d_csc_sparse_mat) :: acsc
|
||||
type(psb_d_coo_sparse_mat) :: acoo
|
||||
integer :: n_row,n_col, nrow_a, nztota
|
||||
type(psb_ctxt_type) :: ctxt
|
||||
integer :: np,me,i, err_act, debug_unit, debug_level
|
||||
character(len=20) :: name='d_slu_solver_bld', ch_err
|
||||
|
||||
info=psb_success_
|
||||
call psb_erractionsave(err_act)
|
||||
debug_unit = psb_get_debug_unit()
|
||||
debug_level = psb_get_debug_level()
|
||||
ctxt = desc_a%get_context()
|
||||
call psb_info(ctxt, me, np)
|
||||
if (debug_level >= psb_debug_outer_) &
|
||||
& write(debug_unit,*) me,' ',trim(name),' start'
|
||||
|
||||
|
||||
n_row = desc_a%get_local_rows()
|
||||
n_col = desc_a%get_local_cols()
|
||||
|
||||
|
||||
call a%cscnv(atmp,info,type='coo')
|
||||
call psb_rwextd(n_row,atmp,info,b=b)
|
||||
call atmp%cscnv(info,type='coo',dupl=psb_dupl_add_)
|
||||
nrow_a = atmp%get_nrows()
|
||||
call atmp%a%csclip(acoo,info,jmax=nrow_a)
|
||||
call acsc%mv_from_coo(acoo,info)
|
||||
nztota = acsc%get_nzeros()
|
||||
! Fix the entries to call C-base SuperLU
|
||||
acsc%ia(:) = acsc%ia(:) - 1
|
||||
acsc%icp(:) = acsc%icp(:) - 1
|
||||
info = amg_dslu_fact(nrow_a,nztota,acsc%val,&
|
||||
& acsc%icp,acsc%ia,sv%lufactors)
|
||||
|
||||
if (info /= psb_success_) then
|
||||
info=psb_err_from_subroutine_
|
||||
ch_err='amg_dslu_fact'
|
||||
call psb_errpush(info,name,a_err=ch_err)
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
call acsc%free()
|
||||
call atmp%free()
|
||||
|
||||
if (debug_level >= psb_debug_outer_) &
|
||||
& write(debug_unit,*) me,' ',trim(name),' end'
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
end subroutine d_slu_solver_bld
|
||||
!!$ subroutine d_slu_solver_apply(alpha,sv,x,beta,y,desc_data,&
|
||||
!!$ & trans,work,info,init,initu)
|
||||
!!$ use psb_base_mod
|
||||
!!$ implicit none
|
||||
!!$ type(psb_desc_type), intent(in) :: desc_data
|
||||
!!$ class(amg_d_slu_solver_type), intent(inout) :: sv
|
||||
!!$ real(psb_dpk_),intent(inout) :: x(:)
|
||||
!!$ real(psb_dpk_),intent(inout) :: y(:)
|
||||
!!$ real(psb_dpk_),intent(in) :: alpha,beta
|
||||
!!$ character(len=1),intent(in) :: trans
|
||||
!!$ real(psb_dpk_),target, intent(inout) :: work(:)
|
||||
!!$ integer, intent(out) :: info
|
||||
!!$ character, intent(in), optional :: init
|
||||
!!$ real(psb_dpk_),intent(inout), optional :: initu(:)
|
||||
!!$
|
||||
!!$ integer :: n_row,n_col
|
||||
!!$ real(psb_dpk_), pointer :: ww(:)
|
||||
!!$ type(psb_ctxt_type) :: ctxt
|
||||
!!$ integer :: np,me,i, err_act
|
||||
!!$ character :: trans_
|
||||
!!$ character(len=20) :: name='d_slu_solver_apply'
|
||||
!!$
|
||||
!!$ call psb_erractionsave(err_act)
|
||||
!!$
|
||||
!!$ info = psb_success_
|
||||
!!$
|
||||
!!$ trans_ = psb_toupper(trans)
|
||||
!!$ select case(trans_)
|
||||
!!$ case('N')
|
||||
!!$ case('T','C')
|
||||
!!$ case default
|
||||
!!$ call psb_errpush(psb_err_iarg_invalid_i_,name)
|
||||
!!$ goto 9999
|
||||
!!$ end select
|
||||
!!$ !
|
||||
!!$ ! For non-iterative solvers, init and initu are ignored.
|
||||
!!$ !
|
||||
!!$
|
||||
!!$ n_row = desc_data%get_local_rows()
|
||||
!!$ n_col = desc_data%get_local_cols()
|
||||
!!$
|
||||
!!$ if (n_col <= size(work)) then
|
||||
!!$ ww => work(1:n_col)
|
||||
!!$ else
|
||||
!!$ allocate(ww(n_col),stat=info)
|
||||
!!$ if (info /= psb_success_) then
|
||||
!!$ info=psb_err_alloc_request_
|
||||
!!$ call psb_errpush(info,name,i_err=(/n_col,0,0,0,0/),&
|
||||
!!$ & a_err='real(psb_dpk_)')
|
||||
!!$ goto 9999
|
||||
!!$ end if
|
||||
!!$ endif
|
||||
!!$
|
||||
!!$ ww(1:n_row) = x(1:n_row)
|
||||
!!$ select case(trans_)
|
||||
!!$ case('N')
|
||||
!!$ info = amg_dslu_solve(0,n_row,1,ww,n_row,sv%lufactors)
|
||||
!!$ case('T')
|
||||
!!$ info = amg_dslu_solve(1,n_row,1,ww,n_row,sv%lufactors)
|
||||
!!$ case('C')
|
||||
!!$ info = amg_dslu_solve(2,n_row,1,ww,n_row,sv%lufactors)
|
||||
!!$ case default
|
||||
!!$ call psb_errpush(psb_err_internal_error_, &
|
||||
!!$ & name,a_err='Invalid TRANS in ILU subsolve')
|
||||
!!$ goto 9999
|
||||
!!$ end select
|
||||
!!$
|
||||
!!$ if (info == psb_success_) &
|
||||
!!$ & call psb_geaxpby(alpha,ww,beta,y,desc_data,info)
|
||||
!!$
|
||||
!!$
|
||||
!!$ if (info /= psb_success_) then
|
||||
!!$ call psb_errpush(psb_err_internal_error_,&
|
||||
!!$ & name,a_err='Error in subsolve')
|
||||
!!$ goto 9999
|
||||
!!$ endif
|
||||
!!$
|
||||
!!$ if (n_col > size(work)) then
|
||||
!!$ deallocate(ww)
|
||||
!!$ endif
|
||||
!!$
|
||||
!!$ call psb_erractionrestore(err_act)
|
||||
!!$ return
|
||||
!!$
|
||||
!!$9999 call psb_error_handler(err_act)
|
||||
!!$ return
|
||||
!!$
|
||||
!!$ end subroutine d_slu_solver_apply
|
||||
!!$
|
||||
!!$ subroutine d_slu_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
|
||||
!!$ & trans,work,wv,info,init,initu)
|
||||
!!$ use psb_base_mod
|
||||
!!$ implicit none
|
||||
!!$ type(psb_desc_type), intent(in) :: desc_data
|
||||
!!$ class(amg_d_slu_solver_type), intent(inout) :: sv
|
||||
!!$ type(psb_d_vect_type),intent(inout) :: x
|
||||
!!$ type(psb_d_vect_type),intent(inout) :: y
|
||||
!!$ real(psb_dpk_),intent(in) :: alpha,beta
|
||||
!!$ character(len=1),intent(in) :: trans
|
||||
!!$ real(psb_dpk_),target, intent(inout) :: work(:)
|
||||
!!$ type(psb_d_vect_type),intent(inout) :: wv(:)
|
||||
!!$ integer, intent(out) :: info
|
||||
!!$ character, intent(in), optional :: init
|
||||
!!$ type(psb_d_vect_type),intent(inout), optional :: initu
|
||||
!!$
|
||||
!!$ integer :: err_act
|
||||
!!$ character(len=20) :: name='d_slu_solver_apply_vect'
|
||||
!!$
|
||||
!!$ call psb_erractionsave(err_act)
|
||||
!!$
|
||||
!!$ info = psb_success_
|
||||
!!$ !
|
||||
!!$ ! For non-iterative solvers, init and initu are ignored.
|
||||
!!$ !
|
||||
!!$
|
||||
!!$ call x%v%sync()
|
||||
!!$ call y%v%sync()
|
||||
!!$ call sv%apply(alpha,x%v%v,beta,y%v%v,desc_data,trans,work,info)
|
||||
!!$ call y%v%set_host()
|
||||
!!$ if (info /= 0) goto 9999
|
||||
!!$
|
||||
!!$ call psb_erractionrestore(err_act)
|
||||
!!$ return
|
||||
!!$
|
||||
!!$9999 call psb_error_handler(err_act)
|
||||
!!$ return
|
||||
!!$
|
||||
!!$ end subroutine d_slu_solver_apply_vect
|
||||
!!$
|
||||
!!$ subroutine d_slu_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
|
||||
!!$
|
||||
!!$ use psb_base_mod
|
||||
!!$
|
||||
!!$ Implicit None
|
||||
!!$
|
||||
!!$ ! Arguments
|
||||
!!$ type(psb_dspmat_type), intent(in), target :: a
|
||||
!!$ Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
!!$ class(amg_d_slu_solver_type), intent(inout) :: sv
|
||||
!!$ integer, intent(out) :: info
|
||||
!!$ type(psb_dspmat_type), intent(in), target, optional :: b
|
||||
!!$ class(psb_d_base_sparse_mat), intent(in), optional :: amold
|
||||
!!$ class(psb_d_base_vect_type), intent(in), optional :: vmold
|
||||
!!$ class(psb_i_base_vect_type), intent(in), optional :: imold
|
||||
!!$ ! Local variables
|
||||
!!$ type(psb_dspmat_type) :: atmp
|
||||
!!$ type(psb_d_csc_sparse_mat) :: acsc
|
||||
!!$ type(psb_d_coo_sparse_mat) :: acoo
|
||||
!!$ integer :: n_row,n_col, nrow_a, nztota
|
||||
!!$ type(psb_ctxt_type) :: ctxt
|
||||
!!$ integer :: np,me,i, err_act, debug_unit, debug_level
|
||||
!!$ character(len=20) :: name='d_slu_solver_bld', ch_err
|
||||
!!$
|
||||
!!$ info=psb_success_
|
||||
!!$ call psb_erractionsave(err_act)
|
||||
!!$ debug_unit = psb_get_debug_unit()
|
||||
!!$ debug_level = psb_get_debug_level()
|
||||
!!$ ctxt = desc_a%get_context()
|
||||
!!$ call psb_info(ctxt, me, np)
|
||||
!!$ if (debug_level >= psb_debug_outer_) &
|
||||
!!$ & write(debug_unit,*) me,' ',trim(name),' start'
|
||||
!!$
|
||||
!!$
|
||||
!!$ n_row = desc_a%get_local_rows()
|
||||
!!$ n_col = desc_a%get_local_cols()
|
||||
!!$
|
||||
!!$
|
||||
!!$ call a%cscnv(atmp,info,type='coo')
|
||||
!!$ call psb_rwextd(n_row,atmp,info,b=b)
|
||||
!!$ call atmp%cscnv(info,type='coo',dupl=psb_dupl_add_)
|
||||
!!$ nrow_a = atmp%get_nrows()
|
||||
!!$ call atmp%a%csclip(acoo,info,jmax=nrow_a)
|
||||
!!$ call acsc%mv_from_coo(acoo,info)
|
||||
!!$ nztota = acsc%get_nzeros()
|
||||
!!$ ! Fix the entries to call C-base SuperLU
|
||||
!!$ acsc%ia(:) = acsc%ia(:) - 1
|
||||
!!$ acsc%icp(:) = acsc%icp(:) - 1
|
||||
!!$ info = amg_dslu_fact(nrow_a,nztota,acsc%val,&
|
||||
!!$ & acsc%icp,acsc%ia,sv%lufactors)
|
||||
!!$
|
||||
!!$ if (info /= psb_success_) then
|
||||
!!$ info=psb_err_from_subroutine_
|
||||
!!$ ch_err='amg_dslu_fact'
|
||||
!!$ call psb_errpush(info,name,a_err=ch_err)
|
||||
!!$ goto 9999
|
||||
!!$ end if
|
||||
!!$
|
||||
!!$ call acsc%free()
|
||||
!!$ call atmp%free()
|
||||
!!$
|
||||
!!$ if (debug_level >= psb_debug_outer_) &
|
||||
!!$ & write(debug_unit,*) me,' ',trim(name),' end'
|
||||
!!$
|
||||
!!$ call psb_erractionrestore(err_act)
|
||||
!!$ return
|
||||
!!$
|
||||
!!$9999 call psb_error_handler(err_act)
|
||||
!!$ return
|
||||
!!$ end subroutine d_slu_solver_bld
|
||||
|
||||
subroutine d_slu_solver_free(sv,info)
|
||||
|
||||
|
||||
+62
-206
@@ -62,9 +62,9 @@ module amg_d_umf_solver
|
||||
type(c_ptr) :: symbolic=c_null_ptr, numeric=c_null_ptr
|
||||
integer(c_long_long) :: symbsize=0, numsize=0
|
||||
contains
|
||||
procedure, pass(sv) :: build => d_umf_solver_bld
|
||||
procedure, pass(sv) :: apply_a => d_umf_solver_apply
|
||||
procedure, pass(sv) :: apply_v => d_umf_solver_apply_vect
|
||||
procedure, pass(sv) :: build => amg_d_umf_solver_bld
|
||||
procedure, pass(sv) :: apply_a => amg_d_umf_solver_apply
|
||||
procedure, pass(sv) :: apply_v => amg_d_umf_solver_apply_vect
|
||||
procedure, pass(sv) :: free => d_umf_solver_free
|
||||
procedure, pass(sv) :: clear_data => d_umf_solver_clear_data
|
||||
procedure, pass(sv) :: descr => d_umf_solver_descr
|
||||
@@ -75,9 +75,8 @@ module amg_d_umf_solver
|
||||
end type amg_d_umf_solver_type
|
||||
|
||||
|
||||
private :: d_umf_solver_bld, d_umf_solver_apply, &
|
||||
& d_umf_solver_free, d_umf_solver_descr, &
|
||||
& d_umf_solver_sizeof, d_umf_solver_apply_vect, &
|
||||
private :: d_umf_solver_free, d_umf_solver_descr, &
|
||||
& d_umf_solver_sizeof, &
|
||||
& d_umf_solver_get_fmt, d_umf_solver_get_id, &
|
||||
& d_umf_solver_clear_data
|
||||
private :: d_umf_solver_finalize
|
||||
@@ -118,208 +117,65 @@ module amg_d_umf_solver
|
||||
end function amg_dumf_free
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_d_umf_solver_apply(alpha,sv,x,beta,y,desc_data,&
|
||||
& trans,work,info,init,initu)
|
||||
use psb_base_mod
|
||||
import amg_d_umf_solver_type
|
||||
implicit none
|
||||
type(psb_desc_type), intent(in) :: desc_data
|
||||
class(amg_d_umf_solver_type), intent(inout) :: sv
|
||||
real(psb_dpk_),intent(inout) :: x(:)
|
||||
real(psb_dpk_),intent(inout) :: y(:)
|
||||
real(psb_dpk_),intent(in) :: alpha,beta
|
||||
character(len=1),intent(in) :: trans
|
||||
real(psb_dpk_),target, intent(inout) :: work(:)
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character, intent(in), optional :: init
|
||||
real(psb_dpk_),intent(inout), optional :: initu(:)
|
||||
end subroutine amg_d_umf_solver_apply
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_d_umf_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
|
||||
& trans,work,wv,info,init,initu)
|
||||
use psb_base_mod
|
||||
import amg_d_umf_solver_type
|
||||
implicit none
|
||||
type(psb_desc_type), intent(in) :: desc_data
|
||||
class(amg_d_umf_solver_type), intent(inout) :: sv
|
||||
type(psb_d_vect_type),intent(inout) :: x
|
||||
type(psb_d_vect_type),intent(inout) :: y
|
||||
real(psb_dpk_),intent(in) :: alpha,beta
|
||||
character(len=1),intent(in) :: trans
|
||||
real(psb_dpk_),target, intent(inout) :: work(:)
|
||||
type(psb_d_vect_type),intent(inout) :: wv(:)
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character, intent(in), optional :: init
|
||||
type(psb_d_vect_type),intent(inout), optional :: initu
|
||||
end subroutine amg_d_umf_solver_apply_vect
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_d_umf_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
|
||||
use psb_base_mod
|
||||
import amg_d_umf_solver_type
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
type(psb_dspmat_type), intent(in), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_d_umf_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
type(psb_dspmat_type), intent(in), target, optional :: b
|
||||
class(psb_d_base_sparse_mat), intent(in), optional :: amold
|
||||
class(psb_d_base_vect_type), intent(in), optional :: vmold
|
||||
class(psb_i_base_vect_type), intent(in), optional :: imold
|
||||
end subroutine amg_d_umf_solver_bld
|
||||
end interface
|
||||
|
||||
contains
|
||||
|
||||
subroutine d_umf_solver_apply(alpha,sv,x,beta,y,desc_data,&
|
||||
& trans,work,info,init,initu)
|
||||
use psb_base_mod
|
||||
implicit none
|
||||
type(psb_desc_type), intent(in) :: desc_data
|
||||
class(amg_d_umf_solver_type), intent(inout) :: sv
|
||||
real(psb_dpk_),intent(inout) :: x(:)
|
||||
real(psb_dpk_),intent(inout) :: y(:)
|
||||
real(psb_dpk_),intent(in) :: alpha,beta
|
||||
character(len=1),intent(in) :: trans
|
||||
real(psb_dpk_),target, intent(inout) :: work(:)
|
||||
integer, intent(out) :: info
|
||||
character, intent(in), optional :: init
|
||||
real(psb_dpk_),intent(inout), optional :: initu(:)
|
||||
|
||||
integer :: n_row,n_col
|
||||
real(psb_dpk_), pointer :: ww(:)
|
||||
integer(psb_ipk_) :: i, err_act
|
||||
character :: trans_
|
||||
character(len=20) :: name='d_umf_solver_apply'
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
info = psb_success_
|
||||
|
||||
trans_ = psb_toupper(trans)
|
||||
select case(trans_)
|
||||
case('N')
|
||||
case('T','C')
|
||||
case default
|
||||
call psb_errpush(psb_err_iarg_invalid_i_,name)
|
||||
goto 9999
|
||||
end select
|
||||
!
|
||||
! For non-iterative solvers, init and initu are ignored.
|
||||
!
|
||||
|
||||
n_row = desc_data%get_local_rows()
|
||||
n_col = desc_data%get_local_cols()
|
||||
|
||||
if (n_col <= size(work)) then
|
||||
ww => work(1:n_col)
|
||||
else
|
||||
allocate(ww(n_col),stat=info)
|
||||
if (info /= psb_success_) then
|
||||
info=psb_err_alloc_request_
|
||||
call psb_errpush(info,name,i_err=(/n_col,0,0,0,0/),&
|
||||
& a_err='real(psb_dpk_)')
|
||||
goto 9999
|
||||
end if
|
||||
endif
|
||||
|
||||
select case(trans_)
|
||||
case('N')
|
||||
info = amg_dumf_solve(0,n_row,ww,x,n_row,sv%numeric)
|
||||
case('T')
|
||||
!
|
||||
! Note: with UMF, 1 meand Ctranspose, 2 means transpose
|
||||
! even for complex data.
|
||||
!
|
||||
if (psb_d_is_complex_) then
|
||||
info = amg_dumf_solve(2,n_row,ww,x,n_row,sv%numeric)
|
||||
else
|
||||
info = amg_dumf_solve(1,n_row,ww,x,n_row,sv%numeric)
|
||||
end if
|
||||
case('C')
|
||||
info = amg_dumf_solve(1,n_row,ww,x,n_row,sv%numeric)
|
||||
case default
|
||||
call psb_errpush(psb_err_internal_error_,name,a_err='Invalid TRANS in ILU subsolve')
|
||||
goto 9999
|
||||
end select
|
||||
|
||||
if (info == psb_success_) call psb_geaxpby(alpha,ww,beta,y,desc_data,info)
|
||||
|
||||
|
||||
if (info /= psb_success_) then
|
||||
call psb_errpush(psb_err_internal_error_,name,a_err='Error in subsolve')
|
||||
goto 9999
|
||||
endif
|
||||
|
||||
if (n_col > size(work)) then
|
||||
deallocate(ww)
|
||||
endif
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
|
||||
end subroutine d_umf_solver_apply
|
||||
|
||||
subroutine d_umf_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
|
||||
& trans,work,wv,info,init,initu)
|
||||
use psb_base_mod
|
||||
implicit none
|
||||
type(psb_desc_type), intent(in) :: desc_data
|
||||
class(amg_d_umf_solver_type), intent(inout) :: sv
|
||||
type(psb_d_vect_type),intent(inout) :: x
|
||||
type(psb_d_vect_type),intent(inout) :: y
|
||||
real(psb_dpk_),intent(in) :: alpha,beta
|
||||
character(len=1),intent(in) :: trans
|
||||
real(psb_dpk_),target, intent(inout) :: work(:)
|
||||
type(psb_d_vect_type),intent(inout) :: wv(:)
|
||||
integer, intent(out) :: info
|
||||
character, intent(in), optional :: init
|
||||
type(psb_d_vect_type),intent(inout), optional :: initu
|
||||
|
||||
integer :: err_act
|
||||
character(len=20) :: name='d_umf_solver_apply_vect'
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
info = psb_success_
|
||||
!
|
||||
! For non-iterative solvers, init and initu are ignored.
|
||||
!
|
||||
|
||||
call x%v%sync()
|
||||
call y%v%sync()
|
||||
call sv%apply(alpha,x%v%v,beta,y%v%v,desc_data,trans,work,info)
|
||||
call y%v%set_host()
|
||||
if (info /= 0) goto 9999
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
|
||||
end subroutine d_umf_solver_apply_vect
|
||||
|
||||
subroutine d_umf_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
|
||||
|
||||
use psb_base_mod
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
type(psb_dspmat_type), intent(in), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_d_umf_solver_type), intent(inout) :: sv
|
||||
integer, intent(out) :: info
|
||||
type(psb_dspmat_type), intent(in), target, optional :: b
|
||||
class(psb_d_base_sparse_mat), intent(in), optional :: amold
|
||||
class(psb_d_base_vect_type), intent(in), optional :: vmold
|
||||
class(psb_i_base_vect_type), intent(in), optional :: imold
|
||||
! Local variables
|
||||
type(psb_dspmat_type) :: atmp
|
||||
type(psb_d_csc_sparse_mat) :: acsc
|
||||
integer :: n_row,n_col, nrow_a, nztota
|
||||
type(psb_ctxt_type) :: ctxt
|
||||
integer :: np,me,i, err_act, debug_unit, debug_level
|
||||
character(len=20) :: name='d_umf_solver_bld', ch_err
|
||||
|
||||
info=psb_success_
|
||||
call psb_erractionsave(err_act)
|
||||
debug_unit = psb_get_debug_unit()
|
||||
debug_level = psb_get_debug_level()
|
||||
ctxt = desc_a%get_context()
|
||||
call psb_info(ctxt, me, np)
|
||||
if (debug_level >= psb_debug_outer_) &
|
||||
& write(debug_unit,*) me,' ',trim(name),' start'
|
||||
|
||||
|
||||
n_row = desc_a%get_local_rows()
|
||||
n_col = desc_a%get_local_cols()
|
||||
|
||||
call a%cscnv(atmp,info,type='coo')
|
||||
call psb_rwextd(n_row,atmp,info,b=b)
|
||||
call atmp%cscnv(info,type='csc',dupl=psb_dupl_add_)
|
||||
call atmp%mv_to(acsc)
|
||||
nrow_a = acsc%get_nrows()
|
||||
nztota = acsc%get_nzeros()
|
||||
! Fix the entres to call C-base UMFPACK.
|
||||
acsc%ia(:) = acsc%ia(:) - 1
|
||||
acsc%icp(:) = acsc%icp(:) - 1
|
||||
info = amg_dumf_fact(nrow_a,nztota,acsc%val,&
|
||||
& acsc%ia,acsc%icp,sv%symbolic,sv%numeric,&
|
||||
& sv%symbsize,sv%numsize)
|
||||
|
||||
if (info /= psb_success_) then
|
||||
info=psb_err_from_subroutine_
|
||||
ch_err='amg_dumf_fact'
|
||||
call psb_errpush(info,name,a_err=ch_err)
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
call acsc%free()
|
||||
call atmp%free()
|
||||
|
||||
if (debug_level >= psb_debug_outer_) &
|
||||
& write(debug_unit,*) me,' ',trim(name),' end'
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
end subroutine d_umf_solver_bld
|
||||
|
||||
subroutine d_umf_solver_free(sv,info)
|
||||
|
||||
|
||||
+261
-205
@@ -63,9 +63,9 @@ module amg_s_slu_solver
|
||||
type(c_ptr) :: lufactors=c_null_ptr
|
||||
integer(c_long_long) :: symbsize=0, numsize=0
|
||||
contains
|
||||
procedure, pass(sv) :: build => s_slu_solver_bld
|
||||
procedure, pass(sv) :: apply_a => s_slu_solver_apply
|
||||
procedure, pass(sv) :: apply_v => s_slu_solver_apply_vect
|
||||
procedure, pass(sv) :: build => amg_s_slu_solver_bld
|
||||
procedure, pass(sv) :: apply_a => amg_s_slu_solver_apply
|
||||
procedure, pass(sv) :: apply_v => amg_s_slu_solver_apply_vect
|
||||
procedure, pass(sv) :: free => s_slu_solver_free
|
||||
procedure, pass(sv) :: clear_data => s_slu_solver_clear_data
|
||||
procedure, pass(sv) :: descr => s_slu_solver_descr
|
||||
@@ -76,9 +76,8 @@ module amg_s_slu_solver
|
||||
end type amg_s_slu_solver_type
|
||||
|
||||
|
||||
private :: s_slu_solver_bld, s_slu_solver_apply, &
|
||||
& s_slu_solver_free, s_slu_solver_descr, &
|
||||
& s_slu_solver_sizeof, s_slu_solver_apply_vect, &
|
||||
private :: s_slu_solver_free, s_slu_solver_descr, &
|
||||
& s_slu_solver_sizeof, &
|
||||
& s_slu_solver_get_fmt, s_slu_solver_get_id, &
|
||||
& s_slu_solver_clear_data
|
||||
private :: s_slu_solver_finalize
|
||||
@@ -118,207 +117,264 @@ module amg_s_slu_solver
|
||||
end function amg_sslu_free
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_s_slu_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
|
||||
use psb_base_mod
|
||||
import amg_s_slu_solver_type
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
type(psb_sspmat_type), intent(in), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_s_slu_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
type(psb_sspmat_type), intent(in), target, optional :: b
|
||||
class(psb_s_base_sparse_mat), intent(in), optional :: amold
|
||||
class(psb_s_base_vect_type), intent(in), optional :: vmold
|
||||
class(psb_i_base_vect_type), intent(in), optional :: imold
|
||||
end subroutine amg_s_slu_solver_bld
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_s_slu_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
|
||||
& trans,work,wv,info,init,initu)
|
||||
use psb_base_mod
|
||||
import amg_s_slu_solver_type
|
||||
implicit none
|
||||
type(psb_desc_type), intent(in) :: desc_data
|
||||
class(amg_s_slu_solver_type), intent(inout) :: sv
|
||||
type(psb_s_vect_type),intent(inout) :: x
|
||||
type(psb_s_vect_type),intent(inout) :: y
|
||||
real(psb_spk_),intent(in) :: alpha,beta
|
||||
character(len=1),intent(in) :: trans
|
||||
real(psb_spk_),target, intent(inout) :: work(:)
|
||||
type(psb_s_vect_type),intent(inout) :: wv(:)
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character, intent(in), optional :: init
|
||||
type(psb_s_vect_type),intent(inout), optional :: initu
|
||||
end subroutine amg_s_slu_solver_apply_vect
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_s_slu_solver_apply(alpha,sv,x,beta,y,desc_data,&
|
||||
& trans,work,info,init,initu)
|
||||
use psb_base_mod
|
||||
import amg_s_slu_solver_type
|
||||
implicit none
|
||||
type(psb_desc_type), intent(in) :: desc_data
|
||||
class(amg_s_slu_solver_type), intent(inout) :: sv
|
||||
real(psb_spk_),intent(inout) :: x(:)
|
||||
real(psb_spk_),intent(inout) :: y(:)
|
||||
real(psb_spk_),intent(in) :: alpha,beta
|
||||
character(len=1),intent(in) :: trans
|
||||
real(psb_spk_),target, intent(inout) :: work(:)
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character, intent(in), optional :: init
|
||||
real(psb_spk_),intent(inout), optional :: initu(:)
|
||||
end subroutine amg_s_slu_solver_apply
|
||||
end interface
|
||||
|
||||
contains
|
||||
|
||||
subroutine s_slu_solver_apply(alpha,sv,x,beta,y,desc_data,&
|
||||
& trans,work,info,init,initu)
|
||||
use psb_base_mod
|
||||
implicit none
|
||||
type(psb_desc_type), intent(in) :: desc_data
|
||||
class(amg_s_slu_solver_type), intent(inout) :: sv
|
||||
real(psb_spk_),intent(inout) :: x(:)
|
||||
real(psb_spk_),intent(inout) :: y(:)
|
||||
real(psb_spk_),intent(in) :: alpha,beta
|
||||
character(len=1),intent(in) :: trans
|
||||
real(psb_spk_),target, intent(inout) :: work(:)
|
||||
integer, intent(out) :: info
|
||||
character, intent(in), optional :: init
|
||||
real(psb_spk_),intent(inout), optional :: initu(:)
|
||||
|
||||
integer :: n_row,n_col
|
||||
real(psb_spk_), pointer :: ww(:)
|
||||
type(psb_ctxt_type) :: ctxt
|
||||
integer :: np,me,i, err_act
|
||||
character :: trans_
|
||||
character(len=20) :: name='s_slu_solver_apply'
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
info = psb_success_
|
||||
|
||||
trans_ = psb_toupper(trans)
|
||||
select case(trans_)
|
||||
case('N')
|
||||
case('T','C')
|
||||
case default
|
||||
call psb_errpush(psb_err_iarg_invalid_i_,name)
|
||||
goto 9999
|
||||
end select
|
||||
!
|
||||
! For non-iterative solvers, init and initu are ignored.
|
||||
!
|
||||
|
||||
n_row = desc_data%get_local_rows()
|
||||
n_col = desc_data%get_local_cols()
|
||||
|
||||
if (n_col <= size(work)) then
|
||||
ww => work(1:n_col)
|
||||
else
|
||||
allocate(ww(n_col),stat=info)
|
||||
if (info /= psb_success_) then
|
||||
info=psb_err_alloc_request_
|
||||
call psb_errpush(info,name,i_err=(/n_col,0,0,0,0/),&
|
||||
& a_err='real(psb_spk_)')
|
||||
goto 9999
|
||||
end if
|
||||
endif
|
||||
|
||||
ww(1:n_row) = x(1:n_row)
|
||||
select case(trans_)
|
||||
case('N')
|
||||
info = amg_sslu_solve(0,n_row,1,ww,n_row,sv%lufactors)
|
||||
case('T')
|
||||
info = amg_sslu_solve(1,n_row,1,ww,n_row,sv%lufactors)
|
||||
case('C')
|
||||
info = amg_sslu_solve(2,n_row,1,ww,n_row,sv%lufactors)
|
||||
case default
|
||||
call psb_errpush(psb_err_internal_error_, &
|
||||
& name,a_err='Invalid TRANS in ILU subsolve')
|
||||
goto 9999
|
||||
end select
|
||||
|
||||
if (info == psb_success_) &
|
||||
& call psb_geaxpby(alpha,ww,beta,y,desc_data,info)
|
||||
|
||||
|
||||
if (info /= psb_success_) then
|
||||
call psb_errpush(psb_err_internal_error_,&
|
||||
& name,a_err='Error in subsolve')
|
||||
goto 9999
|
||||
endif
|
||||
|
||||
if (n_col > size(work)) then
|
||||
deallocate(ww)
|
||||
endif
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
|
||||
end subroutine s_slu_solver_apply
|
||||
|
||||
subroutine s_slu_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
|
||||
& trans,work,wv,info,init,initu)
|
||||
use psb_base_mod
|
||||
implicit none
|
||||
type(psb_desc_type), intent(in) :: desc_data
|
||||
class(amg_s_slu_solver_type), intent(inout) :: sv
|
||||
type(psb_s_vect_type),intent(inout) :: x
|
||||
type(psb_s_vect_type),intent(inout) :: y
|
||||
real(psb_spk_),intent(in) :: alpha,beta
|
||||
character(len=1),intent(in) :: trans
|
||||
real(psb_spk_),target, intent(inout) :: work(:)
|
||||
type(psb_s_vect_type),intent(inout) :: wv(:)
|
||||
integer, intent(out) :: info
|
||||
character, intent(in), optional :: init
|
||||
type(psb_s_vect_type),intent(inout), optional :: initu
|
||||
|
||||
integer :: err_act
|
||||
character(len=20) :: name='s_slu_solver_apply_vect'
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
info = psb_success_
|
||||
!
|
||||
! For non-iterative solvers, init and initu are ignored.
|
||||
!
|
||||
|
||||
call x%v%sync()
|
||||
call y%v%sync()
|
||||
call sv%apply(alpha,x%v%v,beta,y%v%v,desc_data,trans,work,info)
|
||||
call y%v%set_host()
|
||||
if (info /= 0) goto 9999
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
|
||||
end subroutine s_slu_solver_apply_vect
|
||||
|
||||
subroutine s_slu_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
|
||||
|
||||
use psb_base_mod
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
type(psb_sspmat_type), intent(in), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_s_slu_solver_type), intent(inout) :: sv
|
||||
integer, intent(out) :: info
|
||||
type(psb_sspmat_type), intent(in), target, optional :: b
|
||||
class(psb_s_base_sparse_mat), intent(in), optional :: amold
|
||||
class(psb_s_base_vect_type), intent(in), optional :: vmold
|
||||
class(psb_i_base_vect_type), intent(in), optional :: imold
|
||||
! Local variables
|
||||
type(psb_sspmat_type) :: atmp
|
||||
type(psb_s_csc_sparse_mat) :: acsc
|
||||
type(psb_s_coo_sparse_mat) :: acoo
|
||||
integer :: n_row,n_col, nrow_a, nztota
|
||||
type(psb_ctxt_type) :: ctxt
|
||||
integer :: np,me,i, err_act, debug_unit, debug_level
|
||||
character(len=20) :: name='s_slu_solver_bld', ch_err
|
||||
|
||||
info=psb_success_
|
||||
call psb_erractionsave(err_act)
|
||||
debug_unit = psb_get_debug_unit()
|
||||
debug_level = psb_get_debug_level()
|
||||
ctxt = desc_a%get_context()
|
||||
call psb_info(ctxt, me, np)
|
||||
if (debug_level >= psb_debug_outer_) &
|
||||
& write(debug_unit,*) me,' ',trim(name),' start'
|
||||
|
||||
|
||||
n_row = desc_a%get_local_rows()
|
||||
n_col = desc_a%get_local_cols()
|
||||
|
||||
|
||||
call a%cscnv(atmp,info,type='coo')
|
||||
call psb_rwextd(n_row,atmp,info,b=b)
|
||||
call atmp%cscnv(info,type='coo',dupl=psb_dupl_add_)
|
||||
nrow_a = atmp%get_nrows()
|
||||
call atmp%a%csclip(acoo,info,jmax=nrow_a)
|
||||
call acsc%mv_from_coo(acoo,info)
|
||||
nztota = acsc%get_nzeros()
|
||||
! Fix the entries to call C-base SuperLU
|
||||
acsc%ia(:) = acsc%ia(:) - 1
|
||||
acsc%icp(:) = acsc%icp(:) - 1
|
||||
info = amg_sslu_fact(nrow_a,nztota,acsc%val,&
|
||||
& acsc%icp,acsc%ia,sv%lufactors)
|
||||
|
||||
if (info /= psb_success_) then
|
||||
info=psb_err_from_subroutine_
|
||||
ch_err='amg_sslu_fact'
|
||||
call psb_errpush(info,name,a_err=ch_err)
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
call acsc%free()
|
||||
call atmp%free()
|
||||
|
||||
if (debug_level >= psb_debug_outer_) &
|
||||
& write(debug_unit,*) me,' ',trim(name),' end'
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
end subroutine s_slu_solver_bld
|
||||
!!$ subroutine s_slu_solver_apply(alpha,sv,x,beta,y,desc_data,&
|
||||
!!$ & trans,work,info,init,initu)
|
||||
!!$ use psb_base_mod
|
||||
!!$ implicit none
|
||||
!!$ type(psb_desc_type), intent(in) :: desc_data
|
||||
!!$ class(amg_s_slu_solver_type), intent(inout) :: sv
|
||||
!!$ real(psb_spk_),intent(inout) :: x(:)
|
||||
!!$ real(psb_spk_),intent(inout) :: y(:)
|
||||
!!$ real(psb_spk_),intent(in) :: alpha,beta
|
||||
!!$ character(len=1),intent(in) :: trans
|
||||
!!$ real(psb_spk_),target, intent(inout) :: work(:)
|
||||
!!$ integer, intent(out) :: info
|
||||
!!$ character, intent(in), optional :: init
|
||||
!!$ real(psb_spk_),intent(inout), optional :: initu(:)
|
||||
!!$
|
||||
!!$ integer :: n_row,n_col
|
||||
!!$ real(psb_spk_), pointer :: ww(:)
|
||||
!!$ type(psb_ctxt_type) :: ctxt
|
||||
!!$ integer :: np,me,i, err_act
|
||||
!!$ character :: trans_
|
||||
!!$ character(len=20) :: name='s_slu_solver_apply'
|
||||
!!$
|
||||
!!$ call psb_erractionsave(err_act)
|
||||
!!$
|
||||
!!$ info = psb_success_
|
||||
!!$
|
||||
!!$ trans_ = psb_toupper(trans)
|
||||
!!$ select case(trans_)
|
||||
!!$ case('N')
|
||||
!!$ case('T','C')
|
||||
!!$ case default
|
||||
!!$ call psb_errpush(psb_err_iarg_invalid_i_,name)
|
||||
!!$ goto 9999
|
||||
!!$ end select
|
||||
!!$ !
|
||||
!!$ ! For non-iterative solvers, init and initu are ignored.
|
||||
!!$ !
|
||||
!!$
|
||||
!!$ n_row = desc_data%get_local_rows()
|
||||
!!$ n_col = desc_data%get_local_cols()
|
||||
!!$
|
||||
!!$ if (n_col <= size(work)) then
|
||||
!!$ ww => work(1:n_col)
|
||||
!!$ else
|
||||
!!$ allocate(ww(n_col),stat=info)
|
||||
!!$ if (info /= psb_success_) then
|
||||
!!$ info=psb_err_alloc_request_
|
||||
!!$ call psb_errpush(info,name,i_err=(/n_col,0,0,0,0/),&
|
||||
!!$ & a_err='real(psb_spk_)')
|
||||
!!$ goto 9999
|
||||
!!$ end if
|
||||
!!$ endif
|
||||
!!$
|
||||
!!$ ww(1:n_row) = x(1:n_row)
|
||||
!!$ select case(trans_)
|
||||
!!$ case('N')
|
||||
!!$ info = amg_sslu_solve(0,n_row,1,ww,n_row,sv%lufactors)
|
||||
!!$ case('T')
|
||||
!!$ info = amg_sslu_solve(1,n_row,1,ww,n_row,sv%lufactors)
|
||||
!!$ case('C')
|
||||
!!$ info = amg_sslu_solve(2,n_row,1,ww,n_row,sv%lufactors)
|
||||
!!$ case default
|
||||
!!$ call psb_errpush(psb_err_internal_error_, &
|
||||
!!$ & name,a_err='Invalid TRANS in ILU subsolve')
|
||||
!!$ goto 9999
|
||||
!!$ end select
|
||||
!!$
|
||||
!!$ if (info == psb_success_) &
|
||||
!!$ & call psb_geaxpby(alpha,ww,beta,y,desc_data,info)
|
||||
!!$
|
||||
!!$
|
||||
!!$ if (info /= psb_success_) then
|
||||
!!$ call psb_errpush(psb_err_internal_error_,&
|
||||
!!$ & name,a_err='Error in subsolve')
|
||||
!!$ goto 9999
|
||||
!!$ endif
|
||||
!!$
|
||||
!!$ if (n_col > size(work)) then
|
||||
!!$ deallocate(ww)
|
||||
!!$ endif
|
||||
!!$
|
||||
!!$ call psb_erractionrestore(err_act)
|
||||
!!$ return
|
||||
!!$
|
||||
!!$9999 call psb_error_handler(err_act)
|
||||
!!$ return
|
||||
!!$
|
||||
!!$ end subroutine s_slu_solver_apply
|
||||
!!$
|
||||
!!$ subroutine s_slu_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
|
||||
!!$ & trans,work,wv,info,init,initu)
|
||||
!!$ use psb_base_mod
|
||||
!!$ implicit none
|
||||
!!$ type(psb_desc_type), intent(in) :: desc_data
|
||||
!!$ class(amg_s_slu_solver_type), intent(inout) :: sv
|
||||
!!$ type(psb_s_vect_type),intent(inout) :: x
|
||||
!!$ type(psb_s_vect_type),intent(inout) :: y
|
||||
!!$ real(psb_spk_),intent(in) :: alpha,beta
|
||||
!!$ character(len=1),intent(in) :: trans
|
||||
!!$ real(psb_spk_),target, intent(inout) :: work(:)
|
||||
!!$ type(psb_s_vect_type),intent(inout) :: wv(:)
|
||||
!!$ integer, intent(out) :: info
|
||||
!!$ character, intent(in), optional :: init
|
||||
!!$ type(psb_s_vect_type),intent(inout), optional :: initu
|
||||
!!$
|
||||
!!$ integer :: err_act
|
||||
!!$ character(len=20) :: name='s_slu_solver_apply_vect'
|
||||
!!$
|
||||
!!$ call psb_erractionsave(err_act)
|
||||
!!$
|
||||
!!$ info = psb_success_
|
||||
!!$ !
|
||||
!!$ ! For non-iterative solvers, init and initu are ignored.
|
||||
!!$ !
|
||||
!!$
|
||||
!!$ call x%v%sync()
|
||||
!!$ call y%v%sync()
|
||||
!!$ call sv%apply(alpha,x%v%v,beta,y%v%v,desc_data,trans,work,info)
|
||||
!!$ call y%v%set_host()
|
||||
!!$ if (info /= 0) goto 9999
|
||||
!!$
|
||||
!!$ call psb_erractionrestore(err_act)
|
||||
!!$ return
|
||||
!!$
|
||||
!!$9999 call psb_error_handler(err_act)
|
||||
!!$ return
|
||||
!!$
|
||||
!!$ end subroutine s_slu_solver_apply_vect
|
||||
!!$
|
||||
!!$ subroutine s_slu_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
|
||||
!!$
|
||||
!!$ use psb_base_mod
|
||||
!!$
|
||||
!!$ Implicit None
|
||||
!!$
|
||||
!!$ ! Arguments
|
||||
!!$ type(psb_sspmat_type), intent(in), target :: a
|
||||
!!$ Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
!!$ class(amg_s_slu_solver_type), intent(inout) :: sv
|
||||
!!$ integer, intent(out) :: info
|
||||
!!$ type(psb_sspmat_type), intent(in), target, optional :: b
|
||||
!!$ class(psb_s_base_sparse_mat), intent(in), optional :: amold
|
||||
!!$ class(psb_s_base_vect_type), intent(in), optional :: vmold
|
||||
!!$ class(psb_i_base_vect_type), intent(in), optional :: imold
|
||||
!!$ ! Local variables
|
||||
!!$ type(psb_sspmat_type) :: atmp
|
||||
!!$ type(psb_s_csc_sparse_mat) :: acsc
|
||||
!!$ type(psb_s_coo_sparse_mat) :: acoo
|
||||
!!$ integer :: n_row,n_col, nrow_a, nztota
|
||||
!!$ type(psb_ctxt_type) :: ctxt
|
||||
!!$ integer :: np,me,i, err_act, debug_unit, debug_level
|
||||
!!$ character(len=20) :: name='s_slu_solver_bld', ch_err
|
||||
!!$
|
||||
!!$ info=psb_success_
|
||||
!!$ call psb_erractionsave(err_act)
|
||||
!!$ debug_unit = psb_get_debug_unit()
|
||||
!!$ debug_level = psb_get_debug_level()
|
||||
!!$ ctxt = desc_a%get_context()
|
||||
!!$ call psb_info(ctxt, me, np)
|
||||
!!$ if (debug_level >= psb_debug_outer_) &
|
||||
!!$ & write(debug_unit,*) me,' ',trim(name),' start'
|
||||
!!$
|
||||
!!$
|
||||
!!$ n_row = desc_a%get_local_rows()
|
||||
!!$ n_col = desc_a%get_local_cols()
|
||||
!!$
|
||||
!!$
|
||||
!!$ call a%cscnv(atmp,info,type='coo')
|
||||
!!$ call psb_rwextd(n_row,atmp,info,b=b)
|
||||
!!$ call atmp%cscnv(info,type='coo',dupl=psb_dupl_add_)
|
||||
!!$ nrow_a = atmp%get_nrows()
|
||||
!!$ call atmp%a%csclip(acoo,info,jmax=nrow_a)
|
||||
!!$ call acsc%mv_from_coo(acoo,info)
|
||||
!!$ nztota = acsc%get_nzeros()
|
||||
!!$ ! Fix the entries to call C-base SuperLU
|
||||
!!$ acsc%ia(:) = acsc%ia(:) - 1
|
||||
!!$ acsc%icp(:) = acsc%icp(:) - 1
|
||||
!!$ info = amg_sslu_fact(nrow_a,nztota,acsc%val,&
|
||||
!!$ & acsc%icp,acsc%ia,sv%lufactors)
|
||||
!!$
|
||||
!!$ if (info /= psb_success_) then
|
||||
!!$ info=psb_err_from_subroutine_
|
||||
!!$ ch_err='amg_sslu_fact'
|
||||
!!$ call psb_errpush(info,name,a_err=ch_err)
|
||||
!!$ goto 9999
|
||||
!!$ end if
|
||||
!!$
|
||||
!!$ call acsc%free()
|
||||
!!$ call atmp%free()
|
||||
!!$
|
||||
!!$ if (debug_level >= psb_debug_outer_) &
|
||||
!!$ & write(debug_unit,*) me,' ',trim(name),' end'
|
||||
!!$
|
||||
!!$ call psb_erractionrestore(err_act)
|
||||
!!$ return
|
||||
!!$
|
||||
!!$9999 call psb_error_handler(err_act)
|
||||
!!$ return
|
||||
!!$ end subroutine s_slu_solver_bld
|
||||
|
||||
subroutine s_slu_solver_free(sv,info)
|
||||
|
||||
|
||||
+261
-205
@@ -63,9 +63,9 @@ module amg_z_slu_solver
|
||||
type(c_ptr) :: lufactors=c_null_ptr
|
||||
integer(c_long_long) :: symbsize=0, numsize=0
|
||||
contains
|
||||
procedure, pass(sv) :: build => z_slu_solver_bld
|
||||
procedure, pass(sv) :: apply_a => z_slu_solver_apply
|
||||
procedure, pass(sv) :: apply_v => z_slu_solver_apply_vect
|
||||
procedure, pass(sv) :: build => amg_z_slu_solver_bld
|
||||
procedure, pass(sv) :: apply_a => amg_z_slu_solver_apply
|
||||
procedure, pass(sv) :: apply_v => amg_z_slu_solver_apply_vect
|
||||
procedure, pass(sv) :: free => z_slu_solver_free
|
||||
procedure, pass(sv) :: clear_data => z_slu_solver_clear_data
|
||||
procedure, pass(sv) :: descr => z_slu_solver_descr
|
||||
@@ -76,9 +76,8 @@ module amg_z_slu_solver
|
||||
end type amg_z_slu_solver_type
|
||||
|
||||
|
||||
private :: z_slu_solver_bld, z_slu_solver_apply, &
|
||||
& z_slu_solver_free, z_slu_solver_descr, &
|
||||
& z_slu_solver_sizeof, z_slu_solver_apply_vect, &
|
||||
private :: z_slu_solver_free, z_slu_solver_descr, &
|
||||
& z_slu_solver_sizeof, &
|
||||
& z_slu_solver_get_fmt, z_slu_solver_get_id, &
|
||||
& z_slu_solver_clear_data
|
||||
private :: z_slu_solver_finalize
|
||||
@@ -118,207 +117,264 @@ module amg_z_slu_solver
|
||||
end function amg_zslu_free
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_z_slu_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
|
||||
use psb_base_mod
|
||||
import amg_z_slu_solver_type
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
type(psb_zspmat_type), intent(in), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_z_slu_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
type(psb_zspmat_type), intent(in), target, optional :: b
|
||||
class(psb_z_base_sparse_mat), intent(in), optional :: amold
|
||||
class(psb_z_base_vect_type), intent(in), optional :: vmold
|
||||
class(psb_i_base_vect_type), intent(in), optional :: imold
|
||||
end subroutine amg_z_slu_solver_bld
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_z_slu_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
|
||||
& trans,work,wv,info,init,initu)
|
||||
use psb_base_mod
|
||||
import amg_z_slu_solver_type
|
||||
implicit none
|
||||
type(psb_desc_type), intent(in) :: desc_data
|
||||
class(amg_z_slu_solver_type), intent(inout) :: sv
|
||||
type(psb_z_vect_type),intent(inout) :: x
|
||||
type(psb_z_vect_type),intent(inout) :: y
|
||||
complex(psb_dpk_),intent(in) :: alpha,beta
|
||||
character(len=1),intent(in) :: trans
|
||||
complex(psb_dpk_),target, intent(inout) :: work(:)
|
||||
type(psb_z_vect_type),intent(inout) :: wv(:)
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character, intent(in), optional :: init
|
||||
type(psb_z_vect_type),intent(inout), optional :: initu
|
||||
end subroutine amg_z_slu_solver_apply_vect
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_z_slu_solver_apply(alpha,sv,x,beta,y,desc_data,&
|
||||
& trans,work,info,init,initu)
|
||||
use psb_base_mod
|
||||
import amg_z_slu_solver_type
|
||||
implicit none
|
||||
type(psb_desc_type), intent(in) :: desc_data
|
||||
class(amg_z_slu_solver_type), intent(inout) :: sv
|
||||
complex(psb_dpk_),intent(inout) :: x(:)
|
||||
complex(psb_dpk_),intent(inout) :: y(:)
|
||||
complex(psb_dpk_),intent(in) :: alpha,beta
|
||||
character(len=1),intent(in) :: trans
|
||||
complex(psb_dpk_),target, intent(inout) :: work(:)
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character, intent(in), optional :: init
|
||||
complex(psb_dpk_),intent(inout), optional :: initu(:)
|
||||
end subroutine amg_z_slu_solver_apply
|
||||
end interface
|
||||
|
||||
contains
|
||||
|
||||
subroutine z_slu_solver_apply(alpha,sv,x,beta,y,desc_data,&
|
||||
& trans,work,info,init,initu)
|
||||
use psb_base_mod
|
||||
implicit none
|
||||
type(psb_desc_type), intent(in) :: desc_data
|
||||
class(amg_z_slu_solver_type), intent(inout) :: sv
|
||||
complex(psb_dpk_),intent(inout) :: x(:)
|
||||
complex(psb_dpk_),intent(inout) :: y(:)
|
||||
complex(psb_dpk_),intent(in) :: alpha,beta
|
||||
character(len=1),intent(in) :: trans
|
||||
complex(psb_dpk_),target, intent(inout) :: work(:)
|
||||
integer, intent(out) :: info
|
||||
character, intent(in), optional :: init
|
||||
complex(psb_dpk_),intent(inout), optional :: initu(:)
|
||||
|
||||
integer :: n_row,n_col
|
||||
complex(psb_dpk_), pointer :: ww(:)
|
||||
type(psb_ctxt_type) :: ctxt
|
||||
integer :: np,me,i, err_act
|
||||
character :: trans_
|
||||
character(len=20) :: name='z_slu_solver_apply'
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
info = psb_success_
|
||||
|
||||
trans_ = psb_toupper(trans)
|
||||
select case(trans_)
|
||||
case('N')
|
||||
case('T','C')
|
||||
case default
|
||||
call psb_errpush(psb_err_iarg_invalid_i_,name)
|
||||
goto 9999
|
||||
end select
|
||||
!
|
||||
! For non-iterative solvers, init and initu are ignored.
|
||||
!
|
||||
|
||||
n_row = desc_data%get_local_rows()
|
||||
n_col = desc_data%get_local_cols()
|
||||
|
||||
if (n_col <= size(work)) then
|
||||
ww => work(1:n_col)
|
||||
else
|
||||
allocate(ww(n_col),stat=info)
|
||||
if (info /= psb_success_) then
|
||||
info=psb_err_alloc_request_
|
||||
call psb_errpush(info,name,i_err=(/n_col,0,0,0,0/),&
|
||||
& a_err='complex(psb_dpk_)')
|
||||
goto 9999
|
||||
end if
|
||||
endif
|
||||
|
||||
ww(1:n_row) = x(1:n_row)
|
||||
select case(trans_)
|
||||
case('N')
|
||||
info = amg_zslu_solve(0,n_row,1,ww,n_row,sv%lufactors)
|
||||
case('T')
|
||||
info = amg_zslu_solve(1,n_row,1,ww,n_row,sv%lufactors)
|
||||
case('C')
|
||||
info = amg_zslu_solve(2,n_row,1,ww,n_row,sv%lufactors)
|
||||
case default
|
||||
call psb_errpush(psb_err_internal_error_, &
|
||||
& name,a_err='Invalid TRANS in ILU subsolve')
|
||||
goto 9999
|
||||
end select
|
||||
|
||||
if (info == psb_success_) &
|
||||
& call psb_geaxpby(alpha,ww,beta,y,desc_data,info)
|
||||
|
||||
|
||||
if (info /= psb_success_) then
|
||||
call psb_errpush(psb_err_internal_error_,&
|
||||
& name,a_err='Error in subsolve')
|
||||
goto 9999
|
||||
endif
|
||||
|
||||
if (n_col > size(work)) then
|
||||
deallocate(ww)
|
||||
endif
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
|
||||
end subroutine z_slu_solver_apply
|
||||
|
||||
subroutine z_slu_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
|
||||
& trans,work,wv,info,init,initu)
|
||||
use psb_base_mod
|
||||
implicit none
|
||||
type(psb_desc_type), intent(in) :: desc_data
|
||||
class(amg_z_slu_solver_type), intent(inout) :: sv
|
||||
type(psb_z_vect_type),intent(inout) :: x
|
||||
type(psb_z_vect_type),intent(inout) :: y
|
||||
complex(psb_dpk_),intent(in) :: alpha,beta
|
||||
character(len=1),intent(in) :: trans
|
||||
complex(psb_dpk_),target, intent(inout) :: work(:)
|
||||
type(psb_z_vect_type),intent(inout) :: wv(:)
|
||||
integer, intent(out) :: info
|
||||
character, intent(in), optional :: init
|
||||
type(psb_z_vect_type),intent(inout), optional :: initu
|
||||
|
||||
integer :: err_act
|
||||
character(len=20) :: name='z_slu_solver_apply_vect'
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
info = psb_success_
|
||||
!
|
||||
! For non-iterative solvers, init and initu are ignored.
|
||||
!
|
||||
|
||||
call x%v%sync()
|
||||
call y%v%sync()
|
||||
call sv%apply(alpha,x%v%v,beta,y%v%v,desc_data,trans,work,info)
|
||||
call y%v%set_host()
|
||||
if (info /= 0) goto 9999
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
|
||||
end subroutine z_slu_solver_apply_vect
|
||||
|
||||
subroutine z_slu_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
|
||||
|
||||
use psb_base_mod
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
type(psb_zspmat_type), intent(in), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_z_slu_solver_type), intent(inout) :: sv
|
||||
integer, intent(out) :: info
|
||||
type(psb_zspmat_type), intent(in), target, optional :: b
|
||||
class(psb_z_base_sparse_mat), intent(in), optional :: amold
|
||||
class(psb_z_base_vect_type), intent(in), optional :: vmold
|
||||
class(psb_i_base_vect_type), intent(in), optional :: imold
|
||||
! Local variables
|
||||
type(psb_zspmat_type) :: atmp
|
||||
type(psb_z_csc_sparse_mat) :: acsc
|
||||
type(psb_z_coo_sparse_mat) :: acoo
|
||||
integer :: n_row,n_col, nrow_a, nztota
|
||||
type(psb_ctxt_type) :: ctxt
|
||||
integer :: np,me,i, err_act, debug_unit, debug_level
|
||||
character(len=20) :: name='z_slu_solver_bld', ch_err
|
||||
|
||||
info=psb_success_
|
||||
call psb_erractionsave(err_act)
|
||||
debug_unit = psb_get_debug_unit()
|
||||
debug_level = psb_get_debug_level()
|
||||
ctxt = desc_a%get_context()
|
||||
call psb_info(ctxt, me, np)
|
||||
if (debug_level >= psb_debug_outer_) &
|
||||
& write(debug_unit,*) me,' ',trim(name),' start'
|
||||
|
||||
|
||||
n_row = desc_a%get_local_rows()
|
||||
n_col = desc_a%get_local_cols()
|
||||
|
||||
|
||||
call a%cscnv(atmp,info,type='coo')
|
||||
call psb_rwextd(n_row,atmp,info,b=b)
|
||||
call atmp%cscnv(info,type='coo',dupl=psb_dupl_add_)
|
||||
nrow_a = atmp%get_nrows()
|
||||
call atmp%a%csclip(acoo,info,jmax=nrow_a)
|
||||
call acsc%mv_from_coo(acoo,info)
|
||||
nztota = acsc%get_nzeros()
|
||||
! Fix the entries to call C-base SuperLU
|
||||
acsc%ia(:) = acsc%ia(:) - 1
|
||||
acsc%icp(:) = acsc%icp(:) - 1
|
||||
info = amg_zslu_fact(nrow_a,nztota,acsc%val,&
|
||||
& acsc%icp,acsc%ia,sv%lufactors)
|
||||
|
||||
if (info /= psb_success_) then
|
||||
info=psb_err_from_subroutine_
|
||||
ch_err='amg_zslu_fact'
|
||||
call psb_errpush(info,name,a_err=ch_err)
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
call acsc%free()
|
||||
call atmp%free()
|
||||
|
||||
if (debug_level >= psb_debug_outer_) &
|
||||
& write(debug_unit,*) me,' ',trim(name),' end'
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
end subroutine z_slu_solver_bld
|
||||
!!$ subroutine z_slu_solver_apply(alpha,sv,x,beta,y,desc_data,&
|
||||
!!$ & trans,work,info,init,initu)
|
||||
!!$ use psb_base_mod
|
||||
!!$ implicit none
|
||||
!!$ type(psb_desc_type), intent(in) :: desc_data
|
||||
!!$ class(amg_z_slu_solver_type), intent(inout) :: sv
|
||||
!!$ complex(psb_dpk_),intent(inout) :: x(:)
|
||||
!!$ complex(psb_dpk_),intent(inout) :: y(:)
|
||||
!!$ complex(psb_dpk_),intent(in) :: alpha,beta
|
||||
!!$ character(len=1),intent(in) :: trans
|
||||
!!$ complex(psb_dpk_),target, intent(inout) :: work(:)
|
||||
!!$ integer, intent(out) :: info
|
||||
!!$ character, intent(in), optional :: init
|
||||
!!$ complex(psb_dpk_),intent(inout), optional :: initu(:)
|
||||
!!$
|
||||
!!$ integer :: n_row,n_col
|
||||
!!$ complex(psb_dpk_), pointer :: ww(:)
|
||||
!!$ type(psb_ctxt_type) :: ctxt
|
||||
!!$ integer :: np,me,i, err_act
|
||||
!!$ character :: trans_
|
||||
!!$ character(len=20) :: name='z_slu_solver_apply'
|
||||
!!$
|
||||
!!$ call psb_erractionsave(err_act)
|
||||
!!$
|
||||
!!$ info = psb_success_
|
||||
!!$
|
||||
!!$ trans_ = psb_toupper(trans)
|
||||
!!$ select case(trans_)
|
||||
!!$ case('N')
|
||||
!!$ case('T','C')
|
||||
!!$ case default
|
||||
!!$ call psb_errpush(psb_err_iarg_invalid_i_,name)
|
||||
!!$ goto 9999
|
||||
!!$ end select
|
||||
!!$ !
|
||||
!!$ ! For non-iterative solvers, init and initu are ignored.
|
||||
!!$ !
|
||||
!!$
|
||||
!!$ n_row = desc_data%get_local_rows()
|
||||
!!$ n_col = desc_data%get_local_cols()
|
||||
!!$
|
||||
!!$ if (n_col <= size(work)) then
|
||||
!!$ ww => work(1:n_col)
|
||||
!!$ else
|
||||
!!$ allocate(ww(n_col),stat=info)
|
||||
!!$ if (info /= psb_success_) then
|
||||
!!$ info=psb_err_alloc_request_
|
||||
!!$ call psb_errpush(info,name,i_err=(/n_col,0,0,0,0/),&
|
||||
!!$ & a_err='complex(psb_dpk_)')
|
||||
!!$ goto 9999
|
||||
!!$ end if
|
||||
!!$ endif
|
||||
!!$
|
||||
!!$ ww(1:n_row) = x(1:n_row)
|
||||
!!$ select case(trans_)
|
||||
!!$ case('N')
|
||||
!!$ info = amg_zslu_solve(0,n_row,1,ww,n_row,sv%lufactors)
|
||||
!!$ case('T')
|
||||
!!$ info = amg_zslu_solve(1,n_row,1,ww,n_row,sv%lufactors)
|
||||
!!$ case('C')
|
||||
!!$ info = amg_zslu_solve(2,n_row,1,ww,n_row,sv%lufactors)
|
||||
!!$ case default
|
||||
!!$ call psb_errpush(psb_err_internal_error_, &
|
||||
!!$ & name,a_err='Invalid TRANS in ILU subsolve')
|
||||
!!$ goto 9999
|
||||
!!$ end select
|
||||
!!$
|
||||
!!$ if (info == psb_success_) &
|
||||
!!$ & call psb_geaxpby(alpha,ww,beta,y,desc_data,info)
|
||||
!!$
|
||||
!!$
|
||||
!!$ if (info /= psb_success_) then
|
||||
!!$ call psb_errpush(psb_err_internal_error_,&
|
||||
!!$ & name,a_err='Error in subsolve')
|
||||
!!$ goto 9999
|
||||
!!$ endif
|
||||
!!$
|
||||
!!$ if (n_col > size(work)) then
|
||||
!!$ deallocate(ww)
|
||||
!!$ endif
|
||||
!!$
|
||||
!!$ call psb_erractionrestore(err_act)
|
||||
!!$ return
|
||||
!!$
|
||||
!!$9999 call psb_error_handler(err_act)
|
||||
!!$ return
|
||||
!!$
|
||||
!!$ end subroutine z_slu_solver_apply
|
||||
!!$
|
||||
!!$ subroutine z_slu_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
|
||||
!!$ & trans,work,wv,info,init,initu)
|
||||
!!$ use psb_base_mod
|
||||
!!$ implicit none
|
||||
!!$ type(psb_desc_type), intent(in) :: desc_data
|
||||
!!$ class(amg_z_slu_solver_type), intent(inout) :: sv
|
||||
!!$ type(psb_z_vect_type),intent(inout) :: x
|
||||
!!$ type(psb_z_vect_type),intent(inout) :: y
|
||||
!!$ complex(psb_dpk_),intent(in) :: alpha,beta
|
||||
!!$ character(len=1),intent(in) :: trans
|
||||
!!$ complex(psb_dpk_),target, intent(inout) :: work(:)
|
||||
!!$ type(psb_z_vect_type),intent(inout) :: wv(:)
|
||||
!!$ integer, intent(out) :: info
|
||||
!!$ character, intent(in), optional :: init
|
||||
!!$ type(psb_z_vect_type),intent(inout), optional :: initu
|
||||
!!$
|
||||
!!$ integer :: err_act
|
||||
!!$ character(len=20) :: name='z_slu_solver_apply_vect'
|
||||
!!$
|
||||
!!$ call psb_erractionsave(err_act)
|
||||
!!$
|
||||
!!$ info = psb_success_
|
||||
!!$ !
|
||||
!!$ ! For non-iterative solvers, init and initu are ignored.
|
||||
!!$ !
|
||||
!!$
|
||||
!!$ call x%v%sync()
|
||||
!!$ call y%v%sync()
|
||||
!!$ call sv%apply(alpha,x%v%v,beta,y%v%v,desc_data,trans,work,info)
|
||||
!!$ call y%v%set_host()
|
||||
!!$ if (info /= 0) goto 9999
|
||||
!!$
|
||||
!!$ call psb_erractionrestore(err_act)
|
||||
!!$ return
|
||||
!!$
|
||||
!!$9999 call psb_error_handler(err_act)
|
||||
!!$ return
|
||||
!!$
|
||||
!!$ end subroutine z_slu_solver_apply_vect
|
||||
!!$
|
||||
!!$ subroutine z_slu_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
|
||||
!!$
|
||||
!!$ use psb_base_mod
|
||||
!!$
|
||||
!!$ Implicit None
|
||||
!!$
|
||||
!!$ ! Arguments
|
||||
!!$ type(psb_zspmat_type), intent(in), target :: a
|
||||
!!$ Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
!!$ class(amg_z_slu_solver_type), intent(inout) :: sv
|
||||
!!$ integer, intent(out) :: info
|
||||
!!$ type(psb_zspmat_type), intent(in), target, optional :: b
|
||||
!!$ class(psb_z_base_sparse_mat), intent(in), optional :: amold
|
||||
!!$ class(psb_z_base_vect_type), intent(in), optional :: vmold
|
||||
!!$ class(psb_i_base_vect_type), intent(in), optional :: imold
|
||||
!!$ ! Local variables
|
||||
!!$ type(psb_zspmat_type) :: atmp
|
||||
!!$ type(psb_z_csc_sparse_mat) :: acsc
|
||||
!!$ type(psb_z_coo_sparse_mat) :: acoo
|
||||
!!$ integer :: n_row,n_col, nrow_a, nztota
|
||||
!!$ type(psb_ctxt_type) :: ctxt
|
||||
!!$ integer :: np,me,i, err_act, debug_unit, debug_level
|
||||
!!$ character(len=20) :: name='z_slu_solver_bld', ch_err
|
||||
!!$
|
||||
!!$ info=psb_success_
|
||||
!!$ call psb_erractionsave(err_act)
|
||||
!!$ debug_unit = psb_get_debug_unit()
|
||||
!!$ debug_level = psb_get_debug_level()
|
||||
!!$ ctxt = desc_a%get_context()
|
||||
!!$ call psb_info(ctxt, me, np)
|
||||
!!$ if (debug_level >= psb_debug_outer_) &
|
||||
!!$ & write(debug_unit,*) me,' ',trim(name),' start'
|
||||
!!$
|
||||
!!$
|
||||
!!$ n_row = desc_a%get_local_rows()
|
||||
!!$ n_col = desc_a%get_local_cols()
|
||||
!!$
|
||||
!!$
|
||||
!!$ call a%cscnv(atmp,info,type='coo')
|
||||
!!$ call psb_rwextd(n_row,atmp,info,b=b)
|
||||
!!$ call atmp%cscnv(info,type='coo',dupl=psb_dupl_add_)
|
||||
!!$ nrow_a = atmp%get_nrows()
|
||||
!!$ call atmp%a%csclip(acoo,info,jmax=nrow_a)
|
||||
!!$ call acsc%mv_from_coo(acoo,info)
|
||||
!!$ nztota = acsc%get_nzeros()
|
||||
!!$ ! Fix the entries to call C-base SuperLU
|
||||
!!$ acsc%ia(:) = acsc%ia(:) - 1
|
||||
!!$ acsc%icp(:) = acsc%icp(:) - 1
|
||||
!!$ info = amg_zslu_fact(nrow_a,nztota,acsc%val,&
|
||||
!!$ & acsc%icp,acsc%ia,sv%lufactors)
|
||||
!!$
|
||||
!!$ if (info /= psb_success_) then
|
||||
!!$ info=psb_err_from_subroutine_
|
||||
!!$ ch_err='amg_zslu_fact'
|
||||
!!$ call psb_errpush(info,name,a_err=ch_err)
|
||||
!!$ goto 9999
|
||||
!!$ end if
|
||||
!!$
|
||||
!!$ call acsc%free()
|
||||
!!$ call atmp%free()
|
||||
!!$
|
||||
!!$ if (debug_level >= psb_debug_outer_) &
|
||||
!!$ & write(debug_unit,*) me,' ',trim(name),' end'
|
||||
!!$
|
||||
!!$ call psb_erractionrestore(err_act)
|
||||
!!$ return
|
||||
!!$
|
||||
!!$9999 call psb_error_handler(err_act)
|
||||
!!$ return
|
||||
!!$ end subroutine z_slu_solver_bld
|
||||
|
||||
subroutine z_slu_solver_free(sv,info)
|
||||
|
||||
|
||||
+62
-206
@@ -62,9 +62,9 @@ module amg_z_umf_solver
|
||||
type(c_ptr) :: symbolic=c_null_ptr, numeric=c_null_ptr
|
||||
integer(c_long_long) :: symbsize=0, numsize=0
|
||||
contains
|
||||
procedure, pass(sv) :: build => z_umf_solver_bld
|
||||
procedure, pass(sv) :: apply_a => z_umf_solver_apply
|
||||
procedure, pass(sv) :: apply_v => z_umf_solver_apply_vect
|
||||
procedure, pass(sv) :: build => amg_z_umf_solver_bld
|
||||
procedure, pass(sv) :: apply_a => amg_z_umf_solver_apply
|
||||
procedure, pass(sv) :: apply_v => amg_z_umf_solver_apply_vect
|
||||
procedure, pass(sv) :: free => z_umf_solver_free
|
||||
procedure, pass(sv) :: clear_data => z_umf_solver_clear_data
|
||||
procedure, pass(sv) :: descr => z_umf_solver_descr
|
||||
@@ -75,9 +75,8 @@ module amg_z_umf_solver
|
||||
end type amg_z_umf_solver_type
|
||||
|
||||
|
||||
private :: z_umf_solver_bld, z_umf_solver_apply, &
|
||||
& z_umf_solver_free, z_umf_solver_descr, &
|
||||
& z_umf_solver_sizeof, z_umf_solver_apply_vect, &
|
||||
private :: z_umf_solver_free, z_umf_solver_descr, &
|
||||
& z_umf_solver_sizeof, &
|
||||
& z_umf_solver_get_fmt, z_umf_solver_get_id, &
|
||||
& z_umf_solver_clear_data
|
||||
private :: z_umf_solver_finalize
|
||||
@@ -118,208 +117,65 @@ module amg_z_umf_solver
|
||||
end function amg_zumf_free
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_z_umf_solver_apply(alpha,sv,x,beta,y,desc_data,&
|
||||
& trans,work,info,init,initu)
|
||||
use psb_base_mod
|
||||
import amg_z_umf_solver_type
|
||||
implicit none
|
||||
type(psb_desc_type), intent(in) :: desc_data
|
||||
class(amg_z_umf_solver_type), intent(inout) :: sv
|
||||
complex(psb_dpk_),intent(inout) :: x(:)
|
||||
complex(psb_dpk_),intent(inout) :: y(:)
|
||||
complex(psb_dpk_),intent(in) :: alpha,beta
|
||||
character(len=1),intent(in) :: trans
|
||||
complex(psb_dpk_),target, intent(inout) :: work(:)
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character, intent(in), optional :: init
|
||||
complex(psb_dpk_),intent(inout), optional :: initu(:)
|
||||
end subroutine amg_z_umf_solver_apply
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_z_umf_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
|
||||
& trans,work,wv,info,init,initu)
|
||||
use psb_base_mod
|
||||
import amg_z_umf_solver_type
|
||||
implicit none
|
||||
type(psb_desc_type), intent(in) :: desc_data
|
||||
class(amg_z_umf_solver_type), intent(inout) :: sv
|
||||
type(psb_z_vect_type),intent(inout) :: x
|
||||
type(psb_z_vect_type),intent(inout) :: y
|
||||
complex(psb_dpk_),intent(in) :: alpha,beta
|
||||
character(len=1),intent(in) :: trans
|
||||
complex(psb_dpk_),target, intent(inout) :: work(:)
|
||||
type(psb_z_vect_type),intent(inout) :: wv(:)
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character, intent(in), optional :: init
|
||||
type(psb_z_vect_type),intent(inout), optional :: initu
|
||||
end subroutine amg_z_umf_solver_apply_vect
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_z_umf_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
|
||||
use psb_base_mod
|
||||
import amg_z_umf_solver_type
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
type(psb_zspmat_type), intent(in), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_z_umf_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
type(psb_zspmat_type), intent(in), target, optional :: b
|
||||
class(psb_z_base_sparse_mat), intent(in), optional :: amold
|
||||
class(psb_z_base_vect_type), intent(in), optional :: vmold
|
||||
class(psb_i_base_vect_type), intent(in), optional :: imold
|
||||
end subroutine amg_z_umf_solver_bld
|
||||
end interface
|
||||
|
||||
contains
|
||||
|
||||
subroutine z_umf_solver_apply(alpha,sv,x,beta,y,desc_data,&
|
||||
& trans,work,info,init,initu)
|
||||
use psb_base_mod
|
||||
implicit none
|
||||
type(psb_desc_type), intent(in) :: desc_data
|
||||
class(amg_z_umf_solver_type), intent(inout) :: sv
|
||||
complex(psb_dpk_),intent(inout) :: x(:)
|
||||
complex(psb_dpk_),intent(inout) :: y(:)
|
||||
complex(psb_dpk_),intent(in) :: alpha,beta
|
||||
character(len=1),intent(in) :: trans
|
||||
complex(psb_dpk_),target, intent(inout) :: work(:)
|
||||
integer, intent(out) :: info
|
||||
character, intent(in), optional :: init
|
||||
complex(psb_dpk_),intent(inout), optional :: initu(:)
|
||||
|
||||
integer :: n_row,n_col
|
||||
complex(psb_dpk_), pointer :: ww(:)
|
||||
integer(psb_ipk_) :: i, err_act
|
||||
character :: trans_
|
||||
character(len=20) :: name='z_umf_solver_apply'
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
info = psb_success_
|
||||
|
||||
trans_ = psb_toupper(trans)
|
||||
select case(trans_)
|
||||
case('N')
|
||||
case('T','C')
|
||||
case default
|
||||
call psb_errpush(psb_err_iarg_invalid_i_,name)
|
||||
goto 9999
|
||||
end select
|
||||
!
|
||||
! For non-iterative solvers, init and initu are ignored.
|
||||
!
|
||||
|
||||
n_row = desc_data%get_local_rows()
|
||||
n_col = desc_data%get_local_cols()
|
||||
|
||||
if (n_col <= size(work)) then
|
||||
ww => work(1:n_col)
|
||||
else
|
||||
allocate(ww(n_col),stat=info)
|
||||
if (info /= psb_success_) then
|
||||
info=psb_err_alloc_request_
|
||||
call psb_errpush(info,name,i_err=(/n_col,0,0,0,0/),&
|
||||
& a_err='complex(psb_dpk_)')
|
||||
goto 9999
|
||||
end if
|
||||
endif
|
||||
|
||||
select case(trans_)
|
||||
case('N')
|
||||
info = amg_zumf_solve(0,n_row,ww,x,n_row,sv%numeric)
|
||||
case('T')
|
||||
!
|
||||
! Note: with UMF, 1 meand Ctranspose, 2 means transpose
|
||||
! even for complex data.
|
||||
!
|
||||
if (psb_z_is_complex_) then
|
||||
info = amg_zumf_solve(2,n_row,ww,x,n_row,sv%numeric)
|
||||
else
|
||||
info = amg_zumf_solve(1,n_row,ww,x,n_row,sv%numeric)
|
||||
end if
|
||||
case('C')
|
||||
info = amg_zumf_solve(1,n_row,ww,x,n_row,sv%numeric)
|
||||
case default
|
||||
call psb_errpush(psb_err_internal_error_,name,a_err='Invalid TRANS in ILU subsolve')
|
||||
goto 9999
|
||||
end select
|
||||
|
||||
if (info == psb_success_) call psb_geaxpby(alpha,ww,beta,y,desc_data,info)
|
||||
|
||||
|
||||
if (info /= psb_success_) then
|
||||
call psb_errpush(psb_err_internal_error_,name,a_err='Error in subsolve')
|
||||
goto 9999
|
||||
endif
|
||||
|
||||
if (n_col > size(work)) then
|
||||
deallocate(ww)
|
||||
endif
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
|
||||
end subroutine z_umf_solver_apply
|
||||
|
||||
subroutine z_umf_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
|
||||
& trans,work,wv,info,init,initu)
|
||||
use psb_base_mod
|
||||
implicit none
|
||||
type(psb_desc_type), intent(in) :: desc_data
|
||||
class(amg_z_umf_solver_type), intent(inout) :: sv
|
||||
type(psb_z_vect_type),intent(inout) :: x
|
||||
type(psb_z_vect_type),intent(inout) :: y
|
||||
complex(psb_dpk_),intent(in) :: alpha,beta
|
||||
character(len=1),intent(in) :: trans
|
||||
complex(psb_dpk_),target, intent(inout) :: work(:)
|
||||
type(psb_z_vect_type),intent(inout) :: wv(:)
|
||||
integer, intent(out) :: info
|
||||
character, intent(in), optional :: init
|
||||
type(psb_z_vect_type),intent(inout), optional :: initu
|
||||
|
||||
integer :: err_act
|
||||
character(len=20) :: name='z_umf_solver_apply_vect'
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
info = psb_success_
|
||||
!
|
||||
! For non-iterative solvers, init and initu are ignored.
|
||||
!
|
||||
|
||||
call x%v%sync()
|
||||
call y%v%sync()
|
||||
call sv%apply(alpha,x%v%v,beta,y%v%v,desc_data,trans,work,info)
|
||||
call y%v%set_host()
|
||||
if (info /= 0) goto 9999
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
|
||||
end subroutine z_umf_solver_apply_vect
|
||||
|
||||
subroutine z_umf_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
|
||||
|
||||
use psb_base_mod
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
type(psb_zspmat_type), intent(in), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_z_umf_solver_type), intent(inout) :: sv
|
||||
integer, intent(out) :: info
|
||||
type(psb_zspmat_type), intent(in), target, optional :: b
|
||||
class(psb_z_base_sparse_mat), intent(in), optional :: amold
|
||||
class(psb_z_base_vect_type), intent(in), optional :: vmold
|
||||
class(psb_i_base_vect_type), intent(in), optional :: imold
|
||||
! Local variables
|
||||
type(psb_zspmat_type) :: atmp
|
||||
type(psb_z_csc_sparse_mat) :: acsc
|
||||
integer :: n_row,n_col, nrow_a, nztota
|
||||
type(psb_ctxt_type) :: ctxt
|
||||
integer :: np,me,i, err_act, debug_unit, debug_level
|
||||
character(len=20) :: name='z_umf_solver_bld', ch_err
|
||||
|
||||
info=psb_success_
|
||||
call psb_erractionsave(err_act)
|
||||
debug_unit = psb_get_debug_unit()
|
||||
debug_level = psb_get_debug_level()
|
||||
ctxt = desc_a%get_context()
|
||||
call psb_info(ctxt, me, np)
|
||||
if (debug_level >= psb_debug_outer_) &
|
||||
& write(debug_unit,*) me,' ',trim(name),' start'
|
||||
|
||||
|
||||
n_row = desc_a%get_local_rows()
|
||||
n_col = desc_a%get_local_cols()
|
||||
|
||||
call a%cscnv(atmp,info,type='coo')
|
||||
call psb_rwextd(n_row,atmp,info,b=b)
|
||||
call atmp%cscnv(info,type='csc',dupl=psb_dupl_add_)
|
||||
call atmp%mv_to(acsc)
|
||||
nrow_a = acsc%get_nrows()
|
||||
nztota = acsc%get_nzeros()
|
||||
! Fix the entres to call C-base UMFPACK.
|
||||
acsc%ia(:) = acsc%ia(:) - 1
|
||||
acsc%icp(:) = acsc%icp(:) - 1
|
||||
info = amg_zumf_fact(nrow_a,nztota,acsc%val,&
|
||||
& acsc%ia,acsc%icp,sv%symbolic,sv%numeric,&
|
||||
& sv%symbsize,sv%numsize)
|
||||
|
||||
if (info /= psb_success_) then
|
||||
info=psb_err_from_subroutine_
|
||||
ch_err='amg_zumf_fact'
|
||||
call psb_errpush(info,name,a_err=ch_err)
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
call acsc%free()
|
||||
call atmp%free()
|
||||
|
||||
if (debug_level >= psb_debug_outer_) &
|
||||
& write(debug_unit,*) me,' ',trim(name),' end'
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
end subroutine z_umf_solver_bld
|
||||
|
||||
subroutine z_umf_solver_free(sv,info)
|
||||
|
||||
|
||||
@@ -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')
|
||||
|
||||
|
||||
@@ -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')
|
||||
|
||||
|
||||
@@ -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')
|
||||
|
||||
|
||||
@@ -80,7 +80,7 @@ subroutine amg_z_symdec_aggregator_build_tprol(ag,parms,ag_data,&
|
||||
& a,desc_a,ilaggr,nlaggr,op_prol,info)
|
||||
use psb_base_mod
|
||||
use amg_z_prec_type
|
||||
use amg_z_symdec_aggregator_mod, amg_protect_name => amg_z_symdec_aggregator_build_tprol
|
||||
use amg_z_symdec_aggregator_mod, only : amg_z_symdec_aggregator_type
|
||||
use amg_z_inner_mod
|
||||
implicit none
|
||||
class(amg_z_symdec_aggregator_type), target, intent(inout) :: ag
|
||||
@@ -103,6 +103,16 @@ subroutine amg_z_symdec_aggregator_build_tprol(ag,parms,ag_data,&
|
||||
integer(psb_ipk_) :: debug_level, debug_unit
|
||||
logical :: clean_zeros
|
||||
|
||||
!!$ interface
|
||||
!!$ subroutine psb_zaplusat(ain,aout,info)
|
||||
!!$ use psb_z_mat_mod, only : psb_zspmat_type
|
||||
!!$ import :: psb_ipk_
|
||||
!!$ implicit none
|
||||
!!$ type(psb_zspmat_type) :: ain, aout
|
||||
!!$ integer(psb_ipk_) :: info
|
||||
!!$ end subroutine psb_zaplusat
|
||||
!!$ end interface
|
||||
!!$
|
||||
name='amg_z_symdec_aggregator_tprol'
|
||||
call psb_erractionsave(err_act)
|
||||
if (psb_errstatus_fatal()) then
|
||||
@@ -123,15 +133,11 @@ subroutine amg_z_symdec_aggregator_build_tprol(ag,parms,ag_data,&
|
||||
call amg_check_def(parms%aggr_thresh,'Aggr_Thresh',dzero,is_legal_d_aggr_thrs)
|
||||
|
||||
nr = a%get_nrows()
|
||||
call a%csclip(atmp,info,imax=nr,jmax=nr,&
|
||||
call a%csclip(atrans,info,imax=nr,jmax=nr,&
|
||||
& rscale=.false.,cscale=.false.)
|
||||
call atmp%set_nrows(nr)
|
||||
call atmp%set_ncols(nr)
|
||||
if (info == psb_success_) call atmp%transp(atrans)
|
||||
if (info == psb_success_) call atrans%cscnv(info,type='COO')
|
||||
if (info == psb_success_) call psb_rwextd(nr,atmp,info,b=atrans,rowscale=.false.)
|
||||
call atmp%set_nrows(nr)
|
||||
call atmp%set_ncols(nr)
|
||||
call atrans%set_nrows(nr)
|
||||
call atrans%set_ncols(nr)
|
||||
call psb_aplusat(atrans,atmp,info)
|
||||
if (info == psb_success_) call atrans%free()
|
||||
if (info == psb_success_) call atmp%cscnv(info,type='CSR')
|
||||
|
||||
|
||||
@@ -81,8 +81,7 @@
|
||||
subroutine amg_c_smoothers_bld(a,desc_a,prec,info,amold,vmold,imold)
|
||||
|
||||
use psb_base_mod
|
||||
!use amg_c_inner_mod
|
||||
use amg_c_prec_mod, amg_protect_name => amg_c_smoothers_bld
|
||||
use amg_c_prec_type, amg_protect_name => amg_c_smoothers_bld
|
||||
|
||||
Implicit None
|
||||
|
||||
|
||||
@@ -112,7 +112,11 @@ typedef struct {
|
||||
|
||||
int amg_cslu_fact(int n, int nnz,
|
||||
#ifdef AMG_HAVE_SLU
|
||||
#if (AMG_SLU_VERSION >= 7)
|
||||
singlecomplex *values,
|
||||
#else
|
||||
complex *values,
|
||||
#endif
|
||||
#else
|
||||
void *values,
|
||||
#endif
|
||||
@@ -177,10 +181,10 @@ int amg_cslu_fact(int n, int nnz,
|
||||
|
||||
panel_size = sp_ienv(1);
|
||||
relax = sp_ienv(2);
|
||||
#if defined(AMG_SLU_VERSION_5)
|
||||
#if (AMG_SLU_VERSION >= 7) || (AMG_SLU_VERSION == 5)
|
||||
cgstrf(&options, &AC, relax, panel_size, etree,
|
||||
NULL, 0, perm_c, perm_r, L, U, &Glu, &stat, &info);
|
||||
#elif defined(AMG_SLU_VERSION_4)
|
||||
#elif (AMG_SLU_VERSION == 4)
|
||||
cgstrf(&options, &AC, relax, panel_size, etree,
|
||||
NULL, 0, perm_c, perm_r, L, U, &stat, &info);
|
||||
#else
|
||||
@@ -230,7 +234,11 @@ int amg_cslu_fact(int n, int nnz,
|
||||
|
||||
int amg_cslu_solve(int itrans, int n, int nrhs,
|
||||
#ifdef AMG_HAVE_SLU
|
||||
#if (AMG_SLU_VERSION == 7)
|
||||
singlecomplex *b,
|
||||
#else
|
||||
complex *b,
|
||||
#endif
|
||||
#else
|
||||
void *b,
|
||||
#endif
|
||||
|
||||
@@ -81,8 +81,7 @@
|
||||
subroutine amg_d_smoothers_bld(a,desc_a,prec,info,amold,vmold,imold)
|
||||
|
||||
use psb_base_mod
|
||||
!use amg_d_inner_mod
|
||||
use amg_d_prec_mod, amg_protect_name => amg_d_smoothers_bld
|
||||
use amg_d_prec_type, amg_protect_name => amg_d_smoothers_bld
|
||||
|
||||
Implicit None
|
||||
|
||||
|
||||
@@ -171,10 +171,10 @@ int amg_dslu_fact(int n, int nnz, double *values,
|
||||
|
||||
panel_size = sp_ienv(1);
|
||||
relax = sp_ienv(2);
|
||||
#if defined(AMG_SLU_VERSION_5)
|
||||
#if (AMG_SLU_VERSION >= 7) || (AMG_SLU_VERSION == 5)
|
||||
dgstrf(&options, &AC, relax, panel_size, etree,
|
||||
NULL, 0, perm_c, perm_r, L, U, &Glu, &stat, &info);
|
||||
#elif defined(AMG_SLU_VERSION_4)
|
||||
#elif (AMG_SLU_VERSION == 4)
|
||||
dgstrf(&options, &AC, relax, panel_size, etree,
|
||||
NULL, 0, perm_c, perm_r, L, U, &stat, &info);
|
||||
#else
|
||||
|
||||
@@ -81,8 +81,7 @@
|
||||
subroutine amg_s_smoothers_bld(a,desc_a,prec,info,amold,vmold,imold)
|
||||
|
||||
use psb_base_mod
|
||||
!use amg_s_inner_mod
|
||||
use amg_s_prec_mod, amg_protect_name => amg_s_smoothers_bld
|
||||
use amg_s_prec_type, amg_protect_name => amg_s_smoothers_bld
|
||||
|
||||
Implicit None
|
||||
|
||||
|
||||
@@ -172,10 +172,10 @@ int amg_sslu_fact(int n, int nnz, float *values,
|
||||
|
||||
panel_size = sp_ienv(1);
|
||||
relax = sp_ienv(2);
|
||||
#if defined(AMG_SLU_VERSION_5)
|
||||
#if (AMG_SLU_VERSION >= 7) || (AMG_SLU_VERSION == 5)
|
||||
sgstrf(&options, &AC, relax, panel_size,
|
||||
etree, NULL, 0, perm_c, perm_r, L, U, &Glu, &stat, &info);
|
||||
#elif defined(AMG_SLU_VERSION_4)
|
||||
#elif (AMG_SLU_VERSION == 4)
|
||||
sgstrf(&options, &AC, relax, panel_size,
|
||||
etree, NULL, 0, perm_c, perm_r, L, U, &stat, &info);
|
||||
#else
|
||||
|
||||
@@ -81,8 +81,7 @@
|
||||
subroutine amg_z_smoothers_bld(a,desc_a,prec,info,amold,vmold,imold)
|
||||
|
||||
use psb_base_mod
|
||||
!use amg_z_inner_mod
|
||||
use amg_z_prec_mod, amg_protect_name => amg_z_smoothers_bld
|
||||
use amg_z_prec_type, amg_protect_name => amg_z_smoothers_bld
|
||||
|
||||
Implicit None
|
||||
|
||||
|
||||
@@ -176,10 +176,10 @@ int amg_zslu_fact(int n, int nnz,
|
||||
|
||||
panel_size = sp_ienv(1);
|
||||
relax = sp_ienv(2);
|
||||
#if defined(AMG_SLU_VERSION_5)
|
||||
#if (AMG_SLU_VERSION >= 7) || (AMG_SLU_VERSION == 5)
|
||||
zgstrf(&options, &AC, relax, panel_size, etree,
|
||||
NULL, 0, perm_c, perm_r, L, U, &Glu, &stat, &info);
|
||||
#elif defined(AMG_SLU_VERSION_4)
|
||||
#elif (AMG_SLU_VERSION == 4)
|
||||
zgstrf(&options, &AC, relax, panel_size, etree,
|
||||
NULL, 0, perm_c, perm_r, L, U, &stat, &info);
|
||||
#else
|
||||
|
||||
@@ -74,7 +74,7 @@ subroutine amg_c_as_smoother_clone(sm,smout,info)
|
||||
if (info == psb_success_) &
|
||||
& call sm%desc_data%clone(smo%desc_data,info)
|
||||
if ((info==psb_success_).and.(allocated(sm%sv))) then
|
||||
allocate(smout%sv,mold=sm%sv,stat=info)
|
||||
allocate(smo%sv,mold=sm%sv,stat=info)
|
||||
if (info == psb_success_) call sm%sv%clone(smo%sv,info)
|
||||
end if
|
||||
|
||||
|
||||
@@ -74,7 +74,7 @@ subroutine amg_c_jac_smoother_clone(sm,smout,info)
|
||||
smo%tol = sm%tol
|
||||
call sm%nd%clone(smo%nd,info)
|
||||
if ((info==psb_success_).and.(allocated(sm%sv))) then
|
||||
allocate(smout%sv,mold=sm%sv,stat=info)
|
||||
allocate(smo%sv,mold=sm%sv,stat=info)
|
||||
if (info == psb_success_) call sm%sv%clone(smo%sv,info)
|
||||
end if
|
||||
|
||||
|
||||
@@ -74,7 +74,7 @@ subroutine amg_d_as_smoother_clone(sm,smout,info)
|
||||
if (info == psb_success_) &
|
||||
& call sm%desc_data%clone(smo%desc_data,info)
|
||||
if ((info==psb_success_).and.(allocated(sm%sv))) then
|
||||
allocate(smout%sv,mold=sm%sv,stat=info)
|
||||
allocate(smo%sv,mold=sm%sv,stat=info)
|
||||
if (info == psb_success_) call sm%sv%clone(smo%sv,info)
|
||||
end if
|
||||
|
||||
|
||||
@@ -74,7 +74,7 @@ subroutine amg_d_jac_smoother_clone(sm,smout,info)
|
||||
smo%tol = sm%tol
|
||||
call sm%nd%clone(smo%nd,info)
|
||||
if ((info==psb_success_).and.(allocated(sm%sv))) then
|
||||
allocate(smout%sv,mold=sm%sv,stat=info)
|
||||
allocate(smo%sv,mold=sm%sv,stat=info)
|
||||
if (info == psb_success_) call sm%sv%clone(smo%sv,info)
|
||||
end if
|
||||
|
||||
|
||||
@@ -74,7 +74,7 @@ subroutine amg_s_as_smoother_clone(sm,smout,info)
|
||||
if (info == psb_success_) &
|
||||
& call sm%desc_data%clone(smo%desc_data,info)
|
||||
if ((info==psb_success_).and.(allocated(sm%sv))) then
|
||||
allocate(smout%sv,mold=sm%sv,stat=info)
|
||||
allocate(smo%sv,mold=sm%sv,stat=info)
|
||||
if (info == psb_success_) call sm%sv%clone(smo%sv,info)
|
||||
end if
|
||||
|
||||
|
||||
@@ -74,7 +74,7 @@ subroutine amg_s_jac_smoother_clone(sm,smout,info)
|
||||
smo%tol = sm%tol
|
||||
call sm%nd%clone(smo%nd,info)
|
||||
if ((info==psb_success_).and.(allocated(sm%sv))) then
|
||||
allocate(smout%sv,mold=sm%sv,stat=info)
|
||||
allocate(smo%sv,mold=sm%sv,stat=info)
|
||||
if (info == psb_success_) call sm%sv%clone(smo%sv,info)
|
||||
end if
|
||||
|
||||
|
||||
@@ -74,7 +74,7 @@ subroutine amg_z_as_smoother_clone(sm,smout,info)
|
||||
if (info == psb_success_) &
|
||||
& call sm%desc_data%clone(smo%desc_data,info)
|
||||
if ((info==psb_success_).and.(allocated(sm%sv))) then
|
||||
allocate(smout%sv,mold=sm%sv,stat=info)
|
||||
allocate(smo%sv,mold=sm%sv,stat=info)
|
||||
if (info == psb_success_) call sm%sv%clone(smo%sv,info)
|
||||
end if
|
||||
|
||||
|
||||
@@ -74,7 +74,7 @@ subroutine amg_z_jac_smoother_clone(sm,smout,info)
|
||||
smo%tol = sm%tol
|
||||
call sm%nd%clone(smo%nd,info)
|
||||
if ((info==psb_success_).and.(allocated(sm%sv))) then
|
||||
allocate(smout%sv,mold=sm%sv,stat=info)
|
||||
allocate(smo%sv,mold=sm%sv,stat=info)
|
||||
if (info == psb_success_) call sm%sv%clone(smo%sv,info)
|
||||
end if
|
||||
|
||||
|
||||
@@ -54,6 +54,7 @@ amg_c_mumps_solver_apply.o \
|
||||
amg_c_mumps_solver_apply_vect.o \
|
||||
amg_c_mumps_solver_bld.o \
|
||||
amg_c_krm_solver_impl.o \
|
||||
amg_c_slu_solver_impl.o \
|
||||
amg_d_base_solver_apply.o \
|
||||
amg_d_base_solver_apply_vect.o \
|
||||
amg_d_base_solver_bld.o \
|
||||
@@ -101,6 +102,8 @@ amg_d_mumps_solver_apply.o \
|
||||
amg_d_mumps_solver_apply_vect.o \
|
||||
amg_d_mumps_solver_bld.o \
|
||||
amg_d_krm_solver_impl.o \
|
||||
amg_d_slu_solver_impl.o \
|
||||
amg_d_umf_solver_impl.o \
|
||||
amg_s_base_solver_apply.o \
|
||||
amg_s_base_solver_apply_vect.o \
|
||||
amg_s_base_solver_bld.o \
|
||||
@@ -148,6 +151,7 @@ amg_s_mumps_solver_apply.o \
|
||||
amg_s_mumps_solver_apply_vect.o \
|
||||
amg_s_mumps_solver_bld.o \
|
||||
amg_s_krm_solver_impl.o \
|
||||
amg_s_slu_solver_impl.o \
|
||||
amg_z_base_solver_apply.o \
|
||||
amg_z_base_solver_apply_vect.o \
|
||||
amg_z_base_solver_bld.o \
|
||||
@@ -303,6 +307,8 @@ amg_z_invk_solver_clone_settings.o \
|
||||
amg_z_invk_solver_cseti.o \
|
||||
amg_z_invk_solver_descr.o \
|
||||
amg_z_krm_solver_impl.o \
|
||||
amg_z_slu_solver_impl.o \
|
||||
amg_z_umf_solver_impl.o \
|
||||
amg_c_jac_solver_clone_settings.o \
|
||||
amg_c_jac_solver_clear_data.o \
|
||||
amg_c_jac_solver_cnv.o \
|
||||
|
||||
@@ -99,7 +99,7 @@ subroutine amg_c_krm_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
|
||||
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)
|
||||
@@ -190,7 +190,7 @@ subroutine amg_c_krm_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
|
||||
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)
|
||||
@@ -252,7 +252,7 @@ subroutine amg_c_krm_solver_apply(alpha,sv,x,beta,y,desc_data,&
|
||||
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
|
||||
@@ -99,7 +99,7 @@ subroutine amg_d_krm_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
|
||||
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)
|
||||
@@ -190,7 +190,7 @@ subroutine amg_d_krm_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
|
||||
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)
|
||||
@@ -252,7 +252,7 @@ subroutine amg_d_krm_solver_apply(alpha,sv,x,beta,y,desc_data,&
|
||||
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
|
||||
@@ -99,7 +99,7 @@ subroutine amg_s_krm_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
|
||||
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)
|
||||
@@ -190,7 +190,7 @@ subroutine amg_s_krm_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
|
||||
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)
|
||||
@@ -252,7 +252,7 @@ subroutine amg_s_krm_solver_apply(alpha,sv,x,beta,y,desc_data,&
|
||||
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
|
||||
@@ -99,7 +99,7 @@ subroutine amg_z_krm_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
|
||||
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)
|
||||
@@ -190,7 +190,7 @@ subroutine amg_z_krm_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
|
||||
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)
|
||||
@@ -252,7 +252,7 @@ subroutine amg_z_krm_solver_apply(alpha,sv,x,beta,y,desc_data,&
|
||||
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
|
||||
@@ -7,6 +7,8 @@ INCDIR=../include
|
||||
MODDIR=../modules/
|
||||
LIBNAME=$(CBINDLIBNAME)
|
||||
LIBNAME=libamg_cbind.a
|
||||
AMGFDEFINES=-DPSB_HAVE_LAPACK -DPSB_HAVE_FLUSH_STMT -DPSB_MPI_MOD $(PSBFDEFINES) $(FCUDEFINES)
|
||||
FDEFINES=$(AMGFDEFINES)
|
||||
|
||||
objs: amgprecd
|
||||
|
||||
@@ -26,3 +28,4 @@ clean:
|
||||
veryclean: clean
|
||||
cd test/pargen && $(MAKE) clean
|
||||
/bin/rm -f $(HERE)/$(LIBNAME) $(LIBMOD) *$(.mod) *.h
|
||||
|
||||
|
||||
@@ -8,6 +8,8 @@ DEST=../
|
||||
|
||||
CINCLUDES=-I. -I$(INCDIR) -I$(PSBLAS_INCDIR)
|
||||
FINCLUDES=$(FMFLAG)$(HERE) $(FMFLAG)$(INCDIR) $(FMFLAG)$(MODDIR) $(PSBLAS_INCLUDES)
|
||||
AMGFDEFINES=-DPSB_HAVE_LAPACK -DPSB_HAVE_FLUSH_STMT -DPSB_MPI_MOD $(PSBFDEFINES) $(FCUDEFINES)
|
||||
FDEFINES=$(AMGFDEFINES)
|
||||
|
||||
|
||||
OBJS=amg_prec_cbind_mod.o amg_dprec_cbind_mod.o amg_c_dprec.o amg_zprec_cbind_mod.o amg_c_zprec.o
|
||||
|
||||
@@ -4,7 +4,7 @@
|
||||
#include "amg_const.h"
|
||||
#include "psb_base_cbind.h"
|
||||
#include "psb_prec_cbind.h"
|
||||
#include "psb_krylov_cbind.h"
|
||||
#include "psb_linsolve_cbind.h"
|
||||
|
||||
/* Object handle related routines */
|
||||
/* Note: amg_get_XXX_handle returns: <= 0 unsuccessful */
|
||||
@@ -26,10 +26,14 @@ extern "C" {
|
||||
psb_i_t amg_c_dprecbld(psb_c_dspmat *ah, psb_c_descriptor *cdh, amg_c_dprec *ph);
|
||||
psb_i_t amg_c_dhierarchy_build(psb_c_dspmat *ah, psb_c_descriptor *cdh, amg_c_dprec *ph);
|
||||
psb_i_t amg_c_dsmoothers_build(psb_c_dspmat *ah, psb_c_descriptor *cdh, amg_c_dprec *ph);
|
||||
psb_i_t amg_c_dsmoothers_build_opt(psb_c_dspmat *ah, psb_c_descriptor *cdh, amg_c_dprec *ph, const char *afmt, const char *chfmt);
|
||||
psb_i_t amg_c_dprecapply(amg_c_dprec *ph, psb_c_dvector *x, psb_c_dvector *b, psb_c_descriptor *cdh);
|
||||
psb_i_t amg_c_dprecapply_opt(amg_c_dprec *ph, psb_c_dvector *x, psb_c_dvector *b, psb_c_descriptor *cdh, const char *ctrans);
|
||||
psb_i_t amg_c_dprecfree(amg_c_dprec *ph);
|
||||
psb_i_t amg_c_dprecbld_opt(psb_c_dspmat *ah, psb_c_descriptor *cdh,
|
||||
amg_c_dprec *ph, const char *afmt);
|
||||
psb_i_t amg_c_ddescr(amg_c_dprec *ph);
|
||||
psb_i_t amg_c_dallocate_wrk(amg_c_dprec *ph, const char *chfmt);
|
||||
|
||||
psb_i_t amg_c_dkrylov(const char *method, psb_c_dspmat *ah, amg_c_dprec *ph,
|
||||
psb_c_dvector *bh, psb_c_dvector *xh,
|
||||
|
||||
+22
-17
@@ -4,38 +4,43 @@
|
||||
#include "amg_const.h"
|
||||
#include "psb_base_cbind.h"
|
||||
#include "psb_prec_cbind.h"
|
||||
#include "psb_krylov_cbind.h"
|
||||
#include "psb_linsolve_cbind.h"
|
||||
|
||||
/* Object handle related routines */
|
||||
/* Note: amg_get_XXX_handle returns: <= 0 unsuccessful */
|
||||
/* >0 valid handle */
|
||||
#ifdef __cplusplus
|
||||
extern "C" {
|
||||
extern "C"
|
||||
{
|
||||
#endif
|
||||
typedef struct AMG_C_ZPREC {
|
||||
typedef struct AMG_C_ZPREC
|
||||
{
|
||||
void *dprec;
|
||||
} amg_c_zprec;
|
||||
|
||||
amg_c_zprec* amg_c_zprec_new();
|
||||
psb_i_t amg_c_zprec_delete(amg_c_zprec* p);
|
||||
|
||||
} amg_c_zprec;
|
||||
|
||||
amg_c_zprec *amg_c_zprec_new();
|
||||
psb_i_t amg_c_zprec_delete(amg_c_zprec *p);
|
||||
|
||||
psb_i_t amg_c_zprecinit(psb_c_ctxt cctxt, amg_c_zprec *ph, const char *ptype);
|
||||
psb_i_t amg_c_zprecseti(amg_c_zprec *ph, const char *what, psb_i_t val);
|
||||
psb_i_t amg_c_zprecsetc(amg_c_zprec *ph, const char *what, const char *val);
|
||||
psb_i_t amg_c_zprecsetr(amg_c_zprec *ph, const char *what, double val);
|
||||
psb_i_t amg_c_zprecbld(psb_c_dspmat *ah, psb_c_descriptor *cdh, amg_c_zprec *ph);
|
||||
psb_i_t amg_c_zhierarchy_build(psb_c_dspmat *ah, psb_c_descriptor *cdh, amg_c_zprec *ph);
|
||||
psb_i_t amg_c_zsmoothers_build(psb_c_dspmat *ah, psb_c_descriptor *cdh, amg_c_zprec *ph);
|
||||
psb_i_t amg_c_zprecbld(psb_c_zspmat *ah, psb_c_descriptor *cdh, amg_c_zprec *ph);
|
||||
psb_i_t amg_c_zhierarchy_build(psb_c_zspmat *ah, psb_c_descriptor *cdh, amg_c_zprec *ph);
|
||||
psb_i_t amg_c_zsmoothers_build(psb_c_zspmat *ah, psb_c_descriptor *cdh, amg_c_zprec *ph);
|
||||
psb_i_t amg_c_zsmoothers_build_opt(psb_c_zspmat *ah, psb_c_descriptor *cdh, amg_c_zprec *ph, const char *afmt, const char *chfmt);
|
||||
psb_i_t amg_c_zprecapply(amg_c_zprec *ph, psb_c_zvector *x, psb_c_zvector *b, psb_c_descriptor *cdh);
|
||||
psb_i_t amg_c_zprecapply_opt(amg_c_zprec *ph, psb_c_zvector *x, psb_c_zvector *b, psb_c_descriptor *cdh, const char *ctrans);
|
||||
psb_i_t amg_c_zprecfree(amg_c_zprec *ph);
|
||||
psb_i_t amg_c_zprecbld_opt(psb_c_zspmat *ah, psb_c_descriptor *cdh,
|
||||
amg_c_zprec *ph, const char *afmt);
|
||||
psb_i_t amg_c_zprecbld_opt(psb_c_zspmat *ah, psb_c_descriptor *cdh,
|
||||
amg_c_zprec *ph, const char *afmt);
|
||||
|
||||
psb_i_t amg_c_zdescr(amg_c_zprec *ph);
|
||||
psb_i_t amg_c_zallocate_wrk(amg_c_zprec *ph, const char *chfmt);
|
||||
|
||||
psb_i_t amg_c_zkrylov(const char *method, psb_c_zspmat *ah, amg_c_zprec *ph,
|
||||
psb_c_zvector *bh, psb_c_zvector *xh,
|
||||
psb_c_descriptor *cdh, psb_c_SolverOptions *opt);
|
||||
|
||||
psb_i_t amg_c_zkrylov(const char *method, psb_c_zspmat *ah, amg_c_zprec *ph,
|
||||
psb_c_zvector *bh, psb_c_zvector *xh,
|
||||
psb_c_descriptor *cdh, psb_c_SolverOptions *opt);
|
||||
|
||||
#ifdef __cplusplus
|
||||
}
|
||||
|
||||
@@ -21,17 +21,14 @@ contains
|
||||
!#define MLDC_ERR_FILTER(INFO) min(0,INFO)
|
||||
#define MLDC_ERR_FILTER(INFO) (INFO)
|
||||
#define MLDC_ERR_HANDLE(INFO) if(INFO/=amg_success_)MLDC_ERROR("ERROR!")
|
||||
|
||||
function amg_c_dprecinit(cctxt,ph,ptype) bind(c) result(res)
|
||||
use psb_base_mod
|
||||
use amg_prec_mod
|
||||
implicit none
|
||||
|
||||
integer(psb_c_ipk_) :: res
|
||||
type(amg_c_dprec) :: ph
|
||||
type(psb_c_object_type), value :: cctxt
|
||||
character(c_char) :: ptype(*)
|
||||
integer(psb_ipk_) :: info
|
||||
integer(psb_ipk_) :: iret
|
||||
type(amg_dprec_type), pointer :: precp
|
||||
character(len=80) :: fptype
|
||||
|
||||
@@ -41,30 +38,28 @@ contains
|
||||
return
|
||||
end if
|
||||
|
||||
allocate(precp,stat=info)
|
||||
if (info /= 0) return
|
||||
allocate(precp,stat=iret)
|
||||
if (iret /= 0) return
|
||||
|
||||
ph%item = c_loc(precp)
|
||||
|
||||
call stringc2f(ptype,fptype)
|
||||
call psb_stringc2f(ptype,fptype)
|
||||
|
||||
call precp%init(psb_c2f_ctxt(cctxt),fptype,info)
|
||||
call precp%init(psb_c2f_ctxt(cctxt),fptype,iret)
|
||||
|
||||
res = MLDC_ERR_FILTER(info)
|
||||
res = MLDC_ERR_FILTER(iret)
|
||||
MLDC_ERR_HANDLE(res)
|
||||
return
|
||||
end function amg_c_dprecinit
|
||||
|
||||
function amg_c_dprecseti(ph,what,val) bind(c) result(res)
|
||||
use psb_base_mod
|
||||
use amg_prec_mod
|
||||
implicit none
|
||||
|
||||
integer(psb_c_ipk_) :: res
|
||||
type(psb_c_object_type) :: ph
|
||||
character(c_char) :: what(*)
|
||||
integer(psb_c_ipk_), value :: val
|
||||
integer(psb_ipk_) :: info
|
||||
integer(psb_ipk_) :: iret
|
||||
character(len=80) :: fwhat
|
||||
type(amg_dprec_type), pointer :: precp
|
||||
|
||||
@@ -75,26 +70,24 @@ contains
|
||||
return
|
||||
end if
|
||||
|
||||
call stringc2f(what,fwhat)
|
||||
call psb_stringc2f(what,fwhat)
|
||||
|
||||
call precp%set(fwhat,val,info)
|
||||
call precp%set(fwhat,val,iret)
|
||||
|
||||
res = MLDC_ERR_FILTER(info)
|
||||
res = MLDC_ERR_FILTER(iret)
|
||||
MLDC_ERR_HANDLE(res)
|
||||
return
|
||||
end function amg_c_dprecseti
|
||||
|
||||
|
||||
function amg_c_dprecsetr(ph,what,val) bind(c) result(res)
|
||||
use psb_base_mod
|
||||
use amg_prec_mod
|
||||
implicit none
|
||||
|
||||
integer(psb_c_ipk_) :: res
|
||||
type(psb_c_object_type) :: ph
|
||||
character(c_char) :: what(*)
|
||||
real(c_double), value :: val
|
||||
integer(psb_ipk_) :: info
|
||||
integer(psb_ipk_) :: iret
|
||||
character(len=80) :: fwhat
|
||||
type(amg_dprec_type), pointer :: precp
|
||||
|
||||
@@ -105,24 +98,22 @@ contains
|
||||
return
|
||||
end if
|
||||
|
||||
call stringc2f(what,fwhat)
|
||||
call psb_stringc2f(what,fwhat)
|
||||
|
||||
call precp%set(fwhat,val,info)
|
||||
call precp%set(fwhat,val,iret)
|
||||
|
||||
res = MLDC_ERR_FILTER(info)
|
||||
res = MLDC_ERR_FILTER(iret)
|
||||
MLDC_ERR_HANDLE(res)
|
||||
return
|
||||
end function amg_c_dprecsetr
|
||||
|
||||
function amg_c_dprecsetc(ph,what,val) bind(c) result(res)
|
||||
use psb_base_mod
|
||||
use amg_prec_mod
|
||||
implicit none
|
||||
|
||||
integer(psb_c_ipk_) :: res
|
||||
type(psb_c_object_type) :: ph
|
||||
character(c_char) :: what(*), val(*)
|
||||
integer(psb_ipk_) :: info
|
||||
integer(psb_ipk_) :: iret
|
||||
character(len=80) :: fwhat,fval
|
||||
type(amg_dprec_type), pointer :: precp
|
||||
|
||||
@@ -133,28 +124,26 @@ contains
|
||||
return
|
||||
end if
|
||||
|
||||
call stringc2f(what,fwhat)
|
||||
call stringc2f(val,fval)
|
||||
call psb_stringc2f(what,fwhat)
|
||||
call psb_stringc2f(val,fval)
|
||||
|
||||
call precp%set(fwhat,fval,info)
|
||||
call precp%set(fwhat,fval,iret)
|
||||
|
||||
res = MLDC_ERR_FILTER(info)
|
||||
res = MLDC_ERR_FILTER(iret)
|
||||
MLDC_ERR_HANDLE(res)
|
||||
return
|
||||
end function amg_c_dprecsetc
|
||||
|
||||
function amg_c_dprecbld(ah,cdh,ph) bind(c) result(res)
|
||||
use psb_base_mod
|
||||
use amg_prec_mod
|
||||
implicit none
|
||||
|
||||
integer(psb_c_ipk_) :: res
|
||||
type(psb_c_object_type) :: ph,ah,cdh
|
||||
integer(psb_ipk_) :: 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(psb_ipk_) :: 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(psb_ipk_) :: info
|
||||
type(amg_dprec_type), pointer :: precp
|
||||
type(psb_dspmat_type), pointer :: ap
|
||||
type(psb_desc_type), pointer :: descp
|
||||
character(len=80) :: fptype
|
||||
integer(psb_ipk_) :: iret
|
||||
|
||||
res = -1
|
||||
|
||||
@@ -252,21 +237,135 @@ contains
|
||||
return
|
||||
end if
|
||||
|
||||
call precp%smoothers_build(ap,descp,info)
|
||||
call precp%smoothers_build(ap,descp,iret)
|
||||
|
||||
res = MLDC_ERR_FILTER(info)
|
||||
res = MLDC_ERR_FILTER(iret)
|
||||
MLDC_ERR_HANDLE(res)
|
||||
|
||||
return
|
||||
end function amg_c_dsmoothers_build
|
||||
|
||||
function amg_c_dsmoothers_build_opt(ah,cdh,ph,afmt,cdfmt) bind(c) result(res)
|
||||
#if defined (PSB_HAVE_CUDA)
|
||||
use psb_cuda_mod
|
||||
#endif
|
||||
implicit none
|
||||
|
||||
integer(psb_c_ipk_) :: res
|
||||
type(psb_c_object_type) :: ph,ah,cdh
|
||||
type(amg_dprec_type), pointer :: precp
|
||||
type(psb_dspmat_type), pointer :: ap
|
||||
type(psb_desc_type), pointer :: descp
|
||||
character(c_char) :: afmt(*), cdfmt(*)
|
||||
character(len=80) :: fptype
|
||||
integer(psb_ipk_) :: iret
|
||||
! Local variables for formats
|
||||
character(len=10) :: fafmt, fcdfmt
|
||||
#if defined (PSB_HAVE_CUDA)
|
||||
type(psb_d_vect_cuda), target :: dvgpu
|
||||
type(psb_i_vect_cuda), target :: ivgpu
|
||||
! GPU matrix molds
|
||||
type(psb_d_cuda_hlg_sparse_mat), target :: ahlg
|
||||
type(psb_d_cuda_hdiag_sparse_mat), target :: ahdiag
|
||||
type(psb_d_cuda_csrg_sparse_mat), target :: acsrg
|
||||
type(psb_d_cuda_elg_sparse_mat), target :: aelg
|
||||
#endif
|
||||
type(psb_d_base_vect_type), target :: dvhost
|
||||
type(psb_i_base_vect_type), target :: ivhost
|
||||
! CPU matrix molds
|
||||
type(psb_d_ell_sparse_mat), target :: aell
|
||||
type(psb_d_csr_sparse_mat), target :: acsr
|
||||
type(psb_d_coo_sparse_mat), target :: acoo
|
||||
type(psb_d_hll_sparse_mat), target :: ahll
|
||||
type(psb_d_hdia_sparse_mat), target :: ahdia
|
||||
type(psb_d_dns_sparse_mat), target :: adns
|
||||
|
||||
! molding variables
|
||||
class(psb_d_base_vect_type), pointer :: vmold
|
||||
class(psb_d_base_sparse_mat), pointer :: amold
|
||||
class(psb_i_base_vect_type), pointer :: imold
|
||||
|
||||
|
||||
res = -1
|
||||
|
||||
if (c_associated(cdh%item)) then
|
||||
call c_f_pointer(cdh%item,descp)
|
||||
else
|
||||
return
|
||||
end if
|
||||
if (c_associated(ah%item)) then
|
||||
call c_f_pointer(ah%item,ap)
|
||||
else
|
||||
return
|
||||
end if
|
||||
if (c_associated(ph%item)) then
|
||||
call c_f_pointer(ph%item,precp)
|
||||
else
|
||||
return
|
||||
end if
|
||||
! Convert formats
|
||||
call psb_stringc2f(afmt,fafmt)
|
||||
call psb_stringc2f(cdfmt,fcdfmt)
|
||||
! Select matrix mold
|
||||
select case (psb_toupper(fafmt))
|
||||
#if defined (PSB_HAVE_CUDA)
|
||||
case('CSRG')
|
||||
amold => acsrg
|
||||
case('ELG')
|
||||
amold => aelg
|
||||
case('HLG')
|
||||
amold => ahlg
|
||||
case('HDIAG')
|
||||
amold => ahdiag
|
||||
#endif
|
||||
case('CSR')
|
||||
amold => acsr
|
||||
case('ELL')
|
||||
amold => aell
|
||||
case('COO')
|
||||
amold => acoo
|
||||
case('HLL')
|
||||
amold => ahll
|
||||
case('HDIA')
|
||||
amold => ahdia
|
||||
case('DNS')
|
||||
amold => adns
|
||||
case default
|
||||
write(psb_err_unit,'(A)') 'amg_c_dsmoothers_build_format: Unknown format ', fafmt, ' defaulting to CSR'
|
||||
amold => acsr
|
||||
end select
|
||||
! Select vector mold
|
||||
select case (psb_toupper(fcdfmt))
|
||||
#if defined (PSB_HAVE_CUDA)
|
||||
case('GPU','DEVICE')
|
||||
vmold => dvgpu
|
||||
imold => ivgpu
|
||||
#endif
|
||||
case('HOST','CPU')
|
||||
vmold => dvhost
|
||||
imold => ivhost
|
||||
case default
|
||||
write(psb_err_unit,'(A)') 'amg_c_dsmoothers_build_format: Unknown format ', fcdfmt, ' defaulting to HOST/CPU'
|
||||
vmold => dvhost
|
||||
imold => ivhost
|
||||
end select
|
||||
|
||||
|
||||
call precp%smoothers_build(ap,descp,iret,amold=amold,vmold=vmold,imold=imold)
|
||||
|
||||
res = MLDC_ERR_FILTER(iret)
|
||||
MLDC_ERR_HANDLE(res)
|
||||
|
||||
return
|
||||
end function amg_c_dsmoothers_build_opt
|
||||
|
||||
function amg_c_dkrylov(methd,&
|
||||
& ah,ph,bh,xh,cdh,options) bind(c) result(res)
|
||||
use psb_base_mod
|
||||
use psb_prec_mod
|
||||
use psb_linsolve_mod
|
||||
use psb_prec_cbind_mod
|
||||
use psb_dkrylov_cbind_mod
|
||||
use psb_dlinsolve_cbind_mod
|
||||
implicit none
|
||||
integer(psb_c_ipk_) :: res
|
||||
type(psb_c_object_type) :: ah,cdh,ph,bh,xh
|
||||
@@ -288,7 +387,6 @@ contains
|
||||
use psb_linsolve_mod
|
||||
use psb_objhandle_mod
|
||||
use psb_prec_cbind_mod
|
||||
use psb_base_string_cbind_mod
|
||||
implicit none
|
||||
integer(psb_c_ipk_) :: res
|
||||
type(psb_c_object_type) :: ah,cdh,ph,bh,xh
|
||||
@@ -302,7 +400,7 @@ contains
|
||||
type(amg_dprec_type), pointer :: precp
|
||||
type(psb_d_vect_type), pointer :: xp, bp
|
||||
|
||||
integer(psb_ipk_) :: info,fitmax,fitrace,first,fistop,fiter
|
||||
integer(psb_ipk_) :: iret,fitmax,fitrace,first,fistop,fiter
|
||||
character(len=20) :: fmethd
|
||||
real(kind(1.d0)) :: feps,ferr
|
||||
|
||||
@@ -334,7 +432,7 @@ contains
|
||||
end if
|
||||
|
||||
|
||||
call stringc2f(methd,fmethd)
|
||||
call psb_stringc2f(methd,fmethd)
|
||||
feps = eps
|
||||
fitmax = itmax
|
||||
fitrace = itrace
|
||||
@@ -342,23 +440,127 @@ contains
|
||||
fistop = istop
|
||||
|
||||
call psb_krylov(fmethd, ap, precp, bp, xp, feps, &
|
||||
& descp, info,&
|
||||
& descp, iret,&
|
||||
& itmax=fitmax,iter=fiter,itrace=fitrace,istop=fistop,&
|
||||
& irst=first, err=ferr)
|
||||
iter = fiter
|
||||
err = ferr
|
||||
res = min(info,0)
|
||||
res = min(iret,0)
|
||||
|
||||
end function amg_c_dkrylov_opt
|
||||
|
||||
function amg_c_dprecfree(ph) bind(c) result(res)
|
||||
function amg_c_dprecapply(ph,bc,xc,cdh) bind(c,name="amg_c_dprecapply") result(res)
|
||||
use psb_base_mod
|
||||
use amg_prec_mod
|
||||
use psb_prec_mod
|
||||
implicit none
|
||||
|
||||
integer(psb_c_ipk_) :: res
|
||||
type(psb_c_object_type) :: ph ! C handle to preconditioner
|
||||
type(psb_c_object_type) :: bc ! C handle to rhs
|
||||
type(psb_c_object_type) :: xc ! C handle to solution
|
||||
type(psb_c_object_type) :: cdh ! C handle to descriptor
|
||||
|
||||
! Fortran containers for preconditioner, lhs, rhs and descriptor
|
||||
type(amg_dprec_type), pointer :: precp
|
||||
type(psb_d_vect_type), pointer :: xp, bp
|
||||
type(psb_desc_type), pointer :: descp
|
||||
integer(psb_ipk_) :: info
|
||||
|
||||
res = -1
|
||||
! Check descriptor
|
||||
if (c_associated(cdh%item)) then
|
||||
call c_f_pointer(cdh%item,descp)
|
||||
else
|
||||
return
|
||||
end if
|
||||
! Check rhs and solution
|
||||
if (c_associated(bc%item)) then
|
||||
call c_f_pointer(bc%item,bp)
|
||||
else
|
||||
return
|
||||
end if
|
||||
if (c_associated(xc%item)) then
|
||||
call c_f_pointer(xc%item,xp)
|
||||
else
|
||||
return
|
||||
end if
|
||||
! Check preconditioner
|
||||
if (c_associated(ph%item)) then
|
||||
call c_f_pointer(ph%item,precp)
|
||||
else
|
||||
return
|
||||
end if
|
||||
! Apply preconditioner
|
||||
call precp%apply(bp,xp,descp,info)
|
||||
|
||||
! Error handling and return
|
||||
res = MLDC_ERR_FILTER(info)
|
||||
MLDC_ERR_HANDLE(res)
|
||||
return
|
||||
end function amg_c_dprecapply
|
||||
|
||||
function amg_c_dprecapply_opt(ph,bc,xc,cdh,ctrans) bind(c,name="amg_c_dprecapply_opt") result(res)
|
||||
use psb_base_mod
|
||||
use psb_prec_mod
|
||||
implicit none
|
||||
|
||||
integer(psb_c_ipk_) :: res
|
||||
type(psb_c_object_type) :: ph ! C handle to preconditioner
|
||||
type(psb_c_object_type) :: bc ! C handle to rhs
|
||||
type(psb_c_object_type) :: xc ! C handle to solution
|
||||
type(psb_c_object_type) :: cdh ! C handle to descriptor
|
||||
character(c_char) :: ctrans(*) ! Tranpose flag as character
|
||||
|
||||
! Fortran containers for preconditioner, lhs, rhs and descriptor
|
||||
type(amg_dprec_type), pointer :: precp
|
||||
type(psb_d_vect_type), pointer :: xp, bp
|
||||
type(psb_desc_type), pointer :: descp
|
||||
character(len=10) :: ftrans
|
||||
integer(psb_ipk_) :: info
|
||||
|
||||
res = -1
|
||||
! Check descriptor
|
||||
if (c_associated(cdh%item)) then
|
||||
call c_f_pointer(cdh%item,descp)
|
||||
else
|
||||
return
|
||||
end if
|
||||
! Check rhs and solution
|
||||
if (c_associated(bc%item)) then
|
||||
call c_f_pointer(bc%item,bp)
|
||||
else
|
||||
return
|
||||
end if
|
||||
if (c_associated(xc%item)) then
|
||||
call c_f_pointer(xc%item,xp)
|
||||
else
|
||||
return
|
||||
end if
|
||||
! Check preconditioner
|
||||
if (c_associated(ph%item)) then
|
||||
call c_f_pointer(ph%item,precp)
|
||||
else
|
||||
return
|
||||
end if
|
||||
|
||||
! Convert transpose flag
|
||||
call psb_stringc2f(ctrans,ftrans)
|
||||
|
||||
! Apply preconditioner
|
||||
call precp%apply(bp,xp,descp,info,trans=ftrans)
|
||||
|
||||
! Error handling and return
|
||||
res = MLDC_ERR_FILTER(info)
|
||||
MLDC_ERR_HANDLE(res)
|
||||
return
|
||||
end function amg_c_dprecapply_opt
|
||||
|
||||
function amg_c_dprecfree(ph) bind(c) result(res)
|
||||
implicit none
|
||||
|
||||
integer(psb_c_ipk_) :: res
|
||||
type(psb_c_object_type) :: ph
|
||||
integer(psb_ipk_) :: info
|
||||
integer(psb_ipk_) :: iret
|
||||
type(amg_dprec_type), pointer :: precp
|
||||
character(len=80) :: fptype
|
||||
|
||||
@@ -370,39 +572,88 @@ contains
|
||||
end if
|
||||
|
||||
|
||||
call precp%free(info)
|
||||
call precp%free(iret)
|
||||
|
||||
res = MLDC_ERR_FILTER(info)
|
||||
res = MLDC_ERR_FILTER(iret)
|
||||
MLDC_ERR_HANDLE(res)
|
||||
return
|
||||
end function amg_c_dprecfree
|
||||
|
||||
function amg_c_ddescr(ph) bind(c) result(res)
|
||||
use psb_base_mod
|
||||
use amg_prec_mod
|
||||
implicit none
|
||||
implicit none
|
||||
|
||||
integer(psb_c_ipk_) :: res
|
||||
type(psb_c_object_type) :: ph
|
||||
integer(psb_c_ipk_) :: info
|
||||
type(amg_dprec_type), pointer :: precp
|
||||
integer(psb_c_ipk_) :: res
|
||||
type(psb_c_object_type) :: ph
|
||||
integer(psb_c_ipk_) :: iret
|
||||
type(amg_dprec_type), pointer :: precp
|
||||
|
||||
res = -1
|
||||
info = -1
|
||||
if (c_associated(ph%item)) then
|
||||
call c_f_pointer(ph%item,precp)
|
||||
else
|
||||
return
|
||||
end if
|
||||
res = -1
|
||||
iret = -1
|
||||
if (c_associated(ph%item)) then
|
||||
call c_f_pointer(ph%item,precp)
|
||||
else
|
||||
return
|
||||
end if
|
||||
|
||||
|
||||
call precp%descr(info)
|
||||
call flush(psb_out_unit)
|
||||
call precp%descr(iret)
|
||||
call flush(psb_out_unit)
|
||||
|
||||
info = 0
|
||||
res = MLDC_ERR_FILTER(info)
|
||||
MLDC_ERR_HANDLE(res)
|
||||
return
|
||||
end function amg_c_ddescr
|
||||
iret = 0
|
||||
res = MLDC_ERR_FILTER(iret)
|
||||
MLDC_ERR_HANDLE(res)
|
||||
return
|
||||
end function amg_c_ddescr
|
||||
|
||||
function amg_c_dallocate_wrk(ph,chfmt) bind(c, name="amg_c_dallocate_wrk") result(res)
|
||||
#if defined (PSB_HAVE_CUDA)
|
||||
use psb_cuda_mod
|
||||
#endif
|
||||
implicit none
|
||||
|
||||
integer(psb_c_ipk_) :: res
|
||||
type(psb_c_object_type) :: ph
|
||||
character(c_char) :: chfmt(*)
|
||||
integer(psb_ipk_) :: iret
|
||||
type(amg_dprec_type), pointer :: precp
|
||||
character(len=6) :: fchfmt
|
||||
! Local variable
|
||||
integer(psb_ipk_) :: info
|
||||
! Local mold variables
|
||||
#if defined (PSB_HAVE_CUDA)
|
||||
type(psb_d_vect_cuda), target :: dvgpu
|
||||
#endif
|
||||
type(psb_d_base_vect_type), target :: dvhost
|
||||
class(psb_d_base_vect_type), pointer :: vmold
|
||||
|
||||
res = -1
|
||||
if (c_associated(ph%item)) then
|
||||
call c_f_pointer(ph%item,precp)
|
||||
else
|
||||
return
|
||||
end if
|
||||
|
||||
call psb_stringc2f(chfmt,fchfmt)
|
||||
select case (psb_toupper(fchfmt))
|
||||
case('HOST','CPU')
|
||||
vmold => dvhost
|
||||
#if defined (PSB_HAVE_CUDA)
|
||||
case('GPU','DEVICE')
|
||||
vmold => dvgpu
|
||||
#endif
|
||||
case default
|
||||
write(psb_err_unit,'(A)') 'amg_c_dallocate_wrk: Unknown format ', fchfmt, ' defaulting to HOST/CPU'
|
||||
vmold => dvhost
|
||||
end select
|
||||
|
||||
call precp%allocate_wrk(info,vmold=vmold)
|
||||
|
||||
iret = info
|
||||
|
||||
res = MLDC_ERR_FILTER(iret)
|
||||
MLDC_ERR_HANDLE(res)
|
||||
return
|
||||
|
||||
end function amg_c_dallocate_wrk
|
||||
|
||||
end module amg_dprec_cbind_mod
|
||||
|
||||
@@ -23,15 +23,13 @@ contains
|
||||
#define MLDC_ERR_HANDLE(INFO) if(INFO/=amg_success_)MLDC_ERROR("ERROR!")
|
||||
|
||||
function amg_c_zprecinit(cctxt,ph,ptype) bind(c) result(res)
|
||||
use psb_base_mod
|
||||
use amg_prec_mod
|
||||
implicit none
|
||||
|
||||
integer(psb_c_ipk_) :: res
|
||||
type(amg_c_zprec) :: ph
|
||||
type(psb_c_object_type), value :: cctxt
|
||||
character(c_char) :: ptype(*)
|
||||
integer(psb_ipk_) :: info
|
||||
integer(psb_ipk_) :: iret
|
||||
type(amg_zprec_type), pointer :: precp
|
||||
character(len=80) :: fptype
|
||||
|
||||
@@ -41,30 +39,28 @@ contains
|
||||
return
|
||||
end if
|
||||
|
||||
allocate(precp,stat=info)
|
||||
if (info /= 0) return
|
||||
allocate(precp,stat=iret)
|
||||
if (iret /= 0) return
|
||||
|
||||
ph%item = c_loc(precp)
|
||||
|
||||
call stringc2f(ptype,fptype)
|
||||
call psb_stringc2f(ptype,fptype)
|
||||
|
||||
call precp%init(psb_c2f_ctxt(cctxt),fptype,info)
|
||||
call precp%init(psb_c2f_ctxt(cctxt),fptype,iret)
|
||||
|
||||
res = MLDC_ERR_FILTER(info)
|
||||
res = MLDC_ERR_FILTER(iret)
|
||||
MLDC_ERR_HANDLE(res)
|
||||
return
|
||||
end function amg_c_zprecinit
|
||||
|
||||
function amg_c_zprecseti(ph,what,val) bind(c) result(res)
|
||||
use psb_base_mod
|
||||
use amg_prec_mod
|
||||
implicit none
|
||||
|
||||
integer(psb_c_ipk_) :: res
|
||||
type(psb_c_object_type) :: ph
|
||||
character(c_char) :: what(*)
|
||||
integer(psb_c_ipk_), value :: val
|
||||
integer(psb_ipk_) :: info
|
||||
integer(psb_ipk_) :: iret
|
||||
character(len=80) :: fwhat
|
||||
type(amg_zprec_type), pointer :: precp
|
||||
|
||||
@@ -75,26 +71,24 @@ contains
|
||||
return
|
||||
end if
|
||||
|
||||
call stringc2f(what,fwhat)
|
||||
call psb_stringc2f(what,fwhat)
|
||||
|
||||
call precp%set(fwhat,val,info)
|
||||
call precp%set(fwhat,val,iret)
|
||||
|
||||
res = MLDC_ERR_FILTER(info)
|
||||
res = MLDC_ERR_FILTER(iret)
|
||||
MLDC_ERR_HANDLE(res)
|
||||
return
|
||||
end function amg_c_zprecseti
|
||||
|
||||
|
||||
function amg_c_zprecsetr(ph,what,val) bind(c) result(res)
|
||||
use psb_base_mod
|
||||
use amg_prec_mod
|
||||
implicit none
|
||||
|
||||
integer(psb_c_ipk_) :: res
|
||||
type(psb_c_object_type) :: ph
|
||||
character(c_char) :: what(*)
|
||||
real(c_double), value :: val
|
||||
integer(psb_ipk_) :: info
|
||||
integer(psb_ipk_) :: iret
|
||||
character(len=80) :: fwhat
|
||||
type(amg_zprec_type), pointer :: precp
|
||||
|
||||
@@ -105,24 +99,22 @@ contains
|
||||
return
|
||||
end if
|
||||
|
||||
call stringc2f(what,fwhat)
|
||||
call psb_stringc2f(what,fwhat)
|
||||
|
||||
call precp%set(fwhat,val,info)
|
||||
call precp%set(fwhat,val,iret)
|
||||
|
||||
res = MLDC_ERR_FILTER(info)
|
||||
res = MLDC_ERR_FILTER(iret)
|
||||
MLDC_ERR_HANDLE(res)
|
||||
return
|
||||
end function amg_c_zprecsetr
|
||||
|
||||
function amg_c_zprecsetc(ph,what,val) bind(c) result(res)
|
||||
use psb_base_mod
|
||||
use amg_prec_mod
|
||||
implicit none
|
||||
|
||||
integer(psb_c_ipk_) :: res
|
||||
type(psb_c_object_type) :: ph
|
||||
character(c_char) :: what(*), val(*)
|
||||
integer(psb_ipk_) :: info
|
||||
integer(psb_ipk_) :: iret
|
||||
character(len=80) :: fwhat,fval
|
||||
type(amg_zprec_type), pointer :: precp
|
||||
|
||||
@@ -133,24 +125,22 @@ contains
|
||||
return
|
||||
end if
|
||||
|
||||
call stringc2f(what,fwhat)
|
||||
call stringc2f(val,fval)
|
||||
call psb_stringc2f(what,fwhat)
|
||||
call psb_stringc2f(val,fval)
|
||||
|
||||
call precp%set(fwhat,fval,info)
|
||||
call precp%set(fwhat,fval,iret)
|
||||
|
||||
res = MLDC_ERR_FILTER(info)
|
||||
res = MLDC_ERR_FILTER(iret)
|
||||
MLDC_ERR_HANDLE(res)
|
||||
return
|
||||
end function amg_c_zprecsetc
|
||||
|
||||
function amg_c_zprecbld(ah,cdh,ph) bind(c) result(res)
|
||||
use psb_base_mod
|
||||
use amg_prec_mod
|
||||
implicit none
|
||||
|
||||
integer(psb_c_ipk_) :: res
|
||||
type(psb_c_object_type) :: ph,ah,cdh
|
||||
integer(psb_ipk_) :: 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(psb_ipk_) :: 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(psb_ipk_) :: info
|
||||
integer(psb_ipk_) :: iret
|
||||
type(amg_zprec_type), pointer :: precp
|
||||
type(psb_zspmat_type), pointer :: ap
|
||||
type(psb_desc_type), pointer :: descp
|
||||
@@ -252,21 +238,127 @@ contains
|
||||
return
|
||||
end if
|
||||
|
||||
call precp%smoothers_build(ap,descp,info)
|
||||
call precp%smoothers_build(ap,descp,iret)
|
||||
|
||||
res = MLDC_ERR_FILTER(info)
|
||||
res = MLDC_ERR_FILTER(iret)
|
||||
MLDC_ERR_HANDLE(res)
|
||||
|
||||
return
|
||||
end function amg_c_zsmoothers_build
|
||||
|
||||
function amg_c_zsmoothers_build_format(ah,cdh,ph,afmt,cdfmt) bind(c) result(res)
|
||||
#if defined (PSB_HAVE_CUDA)
|
||||
use psb_cuda_mod
|
||||
#endif
|
||||
implicit none
|
||||
|
||||
integer(psb_c_ipk_) :: res
|
||||
type(psb_c_object_type) :: ph,ah,cdh
|
||||
type(amg_zprec_type), pointer :: precp
|
||||
type(psb_zspmat_type), pointer :: ap
|
||||
type(psb_desc_type), pointer :: descp
|
||||
character(c_char) :: afmt(*), cdfmt(*)
|
||||
character(len=80) :: fptype
|
||||
integer(psb_ipk_) :: iret
|
||||
! Local variables for formats
|
||||
character(len=10) :: fafmt, fcdfmt
|
||||
#if defined (PSB_HAVE_CUDA)
|
||||
type(psb_z_vect_cuda), target :: dvgpu
|
||||
type(psb_i_vect_cuda), target :: ivgpu
|
||||
! GPU matrix molds
|
||||
type(psb_z_cuda_hlg_sparse_mat), target :: ahlg
|
||||
type(psb_z_cuda_csrg_sparse_mat), target :: acsrg
|
||||
type(psb_z_cuda_elg_sparse_mat), target :: aelg
|
||||
#endif
|
||||
type(psb_z_base_vect_type), target :: dvhost
|
||||
type(psb_i_base_vect_type), target :: ivhost
|
||||
! CPU matrix molds
|
||||
type(psb_z_ell_sparse_mat), target :: aell
|
||||
type(psb_z_csr_sparse_mat), target :: acsr
|
||||
type(psb_z_coo_sparse_mat), target :: acoo
|
||||
type(psb_z_hll_sparse_mat), target :: ahll
|
||||
type(psb_z_dns_sparse_mat), target :: adns
|
||||
|
||||
! molding variables
|
||||
class(psb_z_base_vect_type), pointer :: vmold
|
||||
class(psb_z_base_sparse_mat), pointer :: amold
|
||||
class(psb_i_base_vect_type), pointer :: imold
|
||||
|
||||
|
||||
res = -1
|
||||
|
||||
if (c_associated(cdh%item)) then
|
||||
call c_f_pointer(cdh%item,descp)
|
||||
else
|
||||
return
|
||||
end if
|
||||
if (c_associated(ah%item)) then
|
||||
call c_f_pointer(ah%item,ap)
|
||||
else
|
||||
return
|
||||
end if
|
||||
if (c_associated(ph%item)) then
|
||||
call c_f_pointer(ph%item,precp)
|
||||
else
|
||||
return
|
||||
end if
|
||||
! Convert formats
|
||||
call psb_stringc2f(afmt,fafmt)
|
||||
call psb_stringc2f(cdfmt,fcdfmt)
|
||||
! Select matrix mold
|
||||
select case (psb_toupper(fafmt))
|
||||
#if defined (PSB_HAVE_CUDA)
|
||||
case('CSRG')
|
||||
amold => acsrg
|
||||
case('ELG')
|
||||
amold => aelg
|
||||
case('HLG')
|
||||
amold => ahlg
|
||||
#endif
|
||||
case('CSR')
|
||||
amold => acsr
|
||||
case('ELL')
|
||||
amold => aell
|
||||
case('COO')
|
||||
amold => acoo
|
||||
case('HLL')
|
||||
amold => ahll
|
||||
case('DNS')
|
||||
amold => adns
|
||||
case default
|
||||
write(psb_err_unit,'(A)') 'amg_c_zsmoothers_build_format: Unknown format ', fafmt, ' defaulting to CSR'
|
||||
amold => acsr
|
||||
end select
|
||||
! Select vector mold
|
||||
select case (psb_toupper(fcdfmt))
|
||||
#if defined (PSB_HAVE_CUDA)
|
||||
case('GPU','DEVICE')
|
||||
vmold => dvgpu
|
||||
imold => ivgpu
|
||||
#endif
|
||||
case('HOST','CPU')
|
||||
vmold => dvhost
|
||||
imold => ivhost
|
||||
case default
|
||||
write(psb_err_unit,'(A)') 'amg_c_zsmoothers_build_format: Unknown format ', fcdfmt, ' defaulting to HOST/CPU'
|
||||
vmold => dvhost
|
||||
imold => ivhost
|
||||
end select
|
||||
|
||||
|
||||
call precp%smoothers_build(ap,descp,iret,amold=amold,vmold=vmold,imold=imold)
|
||||
|
||||
res = MLDC_ERR_FILTER(iret)
|
||||
MLDC_ERR_HANDLE(res)
|
||||
|
||||
return
|
||||
end function amg_c_zsmoothers_build_format
|
||||
|
||||
function amg_c_zkrylov(methd,&
|
||||
& ah,ph,bh,xh,cdh,options) bind(c) result(res)
|
||||
use psb_base_mod
|
||||
use psb_prec_mod
|
||||
use psb_linsolve_mod
|
||||
use psb_prec_cbind_mod
|
||||
use psb_zkrylov_cbind_mod
|
||||
use psb_zlinsolve_cbind_mod
|
||||
implicit none
|
||||
integer(psb_c_ipk_) :: res
|
||||
type(psb_c_object_type) :: ah,cdh,ph,bh,xh
|
||||
@@ -283,12 +375,8 @@ contains
|
||||
|
||||
function amg_c_zkrylov_opt(methd,&
|
||||
& ah,ph,bh,xh,eps,cdh,itmax,iter,err,itrace,irst,istop) bind(c) result(res)
|
||||
use psb_base_mod
|
||||
use psb_prec_mod
|
||||
use psb_linsolve_mod
|
||||
use psb_objhandle_mod
|
||||
use psb_prec_cbind_mod
|
||||
use psb_base_string_cbind_mod
|
||||
implicit none
|
||||
integer(psb_c_ipk_) :: res
|
||||
type(psb_c_object_type) :: ah,cdh,ph,bh,xh
|
||||
@@ -302,7 +390,7 @@ contains
|
||||
type(amg_zprec_type), pointer :: precp
|
||||
type(psb_z_vect_type), pointer :: xp, bp
|
||||
|
||||
integer(psb_ipk_) :: info,fitmax,fitrace,first,fistop,fiter
|
||||
integer(psb_ipk_) :: iret,fitmax,fitrace,first,fistop,fiter
|
||||
character(len=20) :: fmethd
|
||||
real(kind(1.d0)) :: feps,ferr
|
||||
|
||||
@@ -334,7 +422,7 @@ contains
|
||||
end if
|
||||
|
||||
|
||||
call stringc2f(methd,fmethd)
|
||||
call psb_stringc2f(methd,fmethd)
|
||||
feps = eps
|
||||
fitmax = itmax
|
||||
fitrace = itrace
|
||||
@@ -342,23 +430,127 @@ contains
|
||||
fistop = istop
|
||||
|
||||
call psb_krylov(fmethd, ap, precp, bp, xp, feps, &
|
||||
& descp, info,&
|
||||
& descp, iret,&
|
||||
& itmax=fitmax,iter=fiter,itrace=fitrace,istop=fistop,&
|
||||
& irst=first, err=ferr)
|
||||
iter = fiter
|
||||
err = ferr
|
||||
res = min(info,0)
|
||||
res = min(iret,0)
|
||||
|
||||
end function amg_c_zkrylov_opt
|
||||
|
||||
function amg_c_zprecfree(ph) bind(c) result(res)
|
||||
function amg_c_zprecapply(ph,bc,xc,cdh) bind(c,name="amg_c_zprecapply") result(res)
|
||||
use psb_base_mod
|
||||
use amg_prec_mod
|
||||
use psb_prec_mod
|
||||
implicit none
|
||||
|
||||
integer(psb_c_ipk_) :: res
|
||||
type(psb_c_object_type) :: ph ! C handle to preconditioner
|
||||
type(psb_c_object_type) :: bc ! C handle to rhs
|
||||
type(psb_c_object_type) :: xc ! C handle to solution
|
||||
type(psb_c_object_type) :: cdh ! C handle to descriptor
|
||||
|
||||
! Fortran containers for preconditioner, lhs, rhs and descriptor
|
||||
type(amg_zprec_type), pointer :: precp
|
||||
type(psb_z_vect_type), pointer :: xp, bp
|
||||
type(psb_desc_type), pointer :: descp
|
||||
integer(psb_ipk_) :: info
|
||||
|
||||
res = -1
|
||||
! Check descriptor
|
||||
if (c_associated(cdh%item)) then
|
||||
call c_f_pointer(cdh%item,descp)
|
||||
else
|
||||
return
|
||||
end if
|
||||
! Check rhs and solution
|
||||
if (c_associated(bc%item)) then
|
||||
call c_f_pointer(bc%item,bp)
|
||||
else
|
||||
return
|
||||
end if
|
||||
if (c_associated(xc%item)) then
|
||||
call c_f_pointer(xc%item,xp)
|
||||
else
|
||||
return
|
||||
end if
|
||||
! Check preconditioner
|
||||
if (c_associated(ph%item)) then
|
||||
call c_f_pointer(ph%item,precp)
|
||||
else
|
||||
return
|
||||
end if
|
||||
! Apply preconditioner
|
||||
call precp%apply(bp,xp,descp,info)
|
||||
|
||||
! Error handling and return
|
||||
res = MLDC_ERR_FILTER(info)
|
||||
MLDC_ERR_HANDLE(res)
|
||||
return
|
||||
end function amg_c_zprecapply
|
||||
|
||||
function amg_c_zprecapply_opt(ph,bc,xc,cdh,ctrans) bind(c,name="amg_c_zprecapply_opt") result(res)
|
||||
use psb_base_mod
|
||||
use psb_prec_mod
|
||||
implicit none
|
||||
|
||||
integer(psb_c_ipk_) :: res
|
||||
type(psb_c_object_type) :: ph ! C handle to preconditioner
|
||||
type(psb_c_object_type) :: bc ! C handle to rhs
|
||||
type(psb_c_object_type) :: xc ! C handle to solution
|
||||
type(psb_c_object_type) :: cdh ! C handle to descriptor
|
||||
character(c_char) :: ctrans(:) ! Tranpose flag as character
|
||||
|
||||
! Fortran containers for preconditioner, lhs, rhs and descriptor
|
||||
type(amg_zprec_type), pointer :: precp
|
||||
type(psb_z_vect_type), pointer :: xp, bp
|
||||
type(psb_desc_type), pointer :: descp
|
||||
character(len=10) :: ftrans
|
||||
integer(psb_ipk_) :: info
|
||||
|
||||
res = -1
|
||||
! Check descriptor
|
||||
if (c_associated(cdh%item)) then
|
||||
call c_f_pointer(cdh%item,descp)
|
||||
else
|
||||
return
|
||||
end if
|
||||
! Check rhs and solution
|
||||
if (c_associated(bc%item)) then
|
||||
call c_f_pointer(bc%item,bp)
|
||||
else
|
||||
return
|
||||
end if
|
||||
if (c_associated(xc%item)) then
|
||||
call c_f_pointer(xc%item,xp)
|
||||
else
|
||||
return
|
||||
end if
|
||||
! Check preconditioner
|
||||
if (c_associated(ph%item)) then
|
||||
call c_f_pointer(ph%item,precp)
|
||||
else
|
||||
return
|
||||
end if
|
||||
|
||||
! Convert transpose flag
|
||||
call psb_stringc2f(ctrans,ftrans)
|
||||
|
||||
! Apply preconditioner
|
||||
call precp%apply(bp,xp,descp,info,trans=ftrans)
|
||||
|
||||
! Error handling and return
|
||||
res = MLDC_ERR_FILTER(info)
|
||||
MLDC_ERR_HANDLE(res)
|
||||
return
|
||||
end function amg_c_zprecapply_opt
|
||||
|
||||
function amg_c_zprecfree(ph) bind(c) result(res)
|
||||
implicit none
|
||||
|
||||
integer(psb_c_ipk_) :: res
|
||||
type(psb_c_object_type) :: ph
|
||||
integer(psb_ipk_) :: info
|
||||
integer(psb_ipk_) :: iret
|
||||
type(amg_zprec_type), pointer :: precp
|
||||
character(len=80) :: fptype
|
||||
|
||||
@@ -370,25 +562,23 @@ contains
|
||||
end if
|
||||
|
||||
|
||||
call precp%free(info)
|
||||
call precp%free(iret)
|
||||
|
||||
res = MLDC_ERR_FILTER(info)
|
||||
res = MLDC_ERR_FILTER(iret)
|
||||
MLDC_ERR_HANDLE(res)
|
||||
return
|
||||
end function amg_c_zprecfree
|
||||
|
||||
function amg_c_zdescr(ph) bind(c) result(res)
|
||||
use psb_base_mod
|
||||
use amg_prec_mod
|
||||
implicit none
|
||||
|
||||
integer(psb_c_ipk_) :: res
|
||||
type(psb_c_object_type) :: ph
|
||||
integer(psb_c_ipk_) :: info
|
||||
integer(psb_c_ipk_) :: iret
|
||||
type(amg_zprec_type), pointer :: precp
|
||||
|
||||
res = -1
|
||||
info = -1
|
||||
iret = -1
|
||||
if (c_associated(ph%item)) then
|
||||
call c_f_pointer(ph%item,precp)
|
||||
else
|
||||
@@ -396,13 +586,64 @@ contains
|
||||
end if
|
||||
|
||||
|
||||
call precp%descr(info)
|
||||
call precp%descr(iret)
|
||||
call flush(psb_out_unit)
|
||||
|
||||
info = 0
|
||||
res = MLDC_ERR_FILTER(info)
|
||||
iret = 0
|
||||
res = MLDC_ERR_FILTER(iret)
|
||||
MLDC_ERR_HANDLE(res)
|
||||
return
|
||||
end function amg_c_zdescr
|
||||
|
||||
function amg_c_zallocate_wrk(ph,chfmt) bind(c, name="amg_c_zallocate_wrk") result(res)
|
||||
#if defined (PSB_HAVE_CUDA)
|
||||
use psb_cuda_mod
|
||||
#endif
|
||||
implicit none
|
||||
|
||||
integer(psb_c_ipk_) :: res
|
||||
type(psb_c_object_type) :: ph
|
||||
character(c_char) :: chfmt(*)
|
||||
integer(psb_ipk_) :: iret
|
||||
type(amg_zprec_type), pointer :: precp
|
||||
character(len=6) :: fchfmt
|
||||
! Local variable
|
||||
integer(psb_ipk_) :: info
|
||||
! Local mold variables
|
||||
#if defined (PSB_HAVE_CUDA)
|
||||
type(psb_z_vect_cuda), target :: zvgpu
|
||||
#endif
|
||||
type(psb_z_base_vect_type), target :: zvhost
|
||||
class(psb_z_base_vect_type), pointer :: vmold
|
||||
|
||||
res = -1
|
||||
if (c_associated(ph%item)) then
|
||||
call c_f_pointer(ph%item,precp)
|
||||
else
|
||||
return
|
||||
end if
|
||||
|
||||
call psb_stringc2f(chfmt,fchfmt)
|
||||
select case (psb_toupper(fchfmt))
|
||||
case('HOST','CPU')
|
||||
vmold => zvhost
|
||||
#if defined (PSB_HAVE_CUDA)
|
||||
case('GPU','DEVICE')
|
||||
vmold => zvgpu
|
||||
#endif
|
||||
case default
|
||||
write(psb_err_unit,'(A)') 'amg_c_zallocate_wrk: Unknown format ', fchfmt, ' defaulting to HOST/CPU'
|
||||
vmold => zvhost
|
||||
end select
|
||||
|
||||
call precp%allocate_wrk(info,vmold=vmold)
|
||||
|
||||
iret = info
|
||||
|
||||
res = MLDC_ERR_FILTER(iret)
|
||||
MLDC_ERR_HANDLE(res)
|
||||
return
|
||||
|
||||
end function amg_c_zallocate_wrk
|
||||
|
||||
end module amg_zprec_cbind_mod
|
||||
|
||||
@@ -8,7 +8,7 @@ HERE=.
|
||||
|
||||
FINCLUDES=$(FMFLAG). $(FMFLAG)$(LIBDIR) $(FMFLAG)$(PSBLAS_INCDIR)
|
||||
#PSBLAS_LIBS= -L$(PSBLAS_LIBDIR) -L$(LIBDIR) $(CPSBLAS_LIB) $(PSBLAS_LIB)
|
||||
# -lpsb_krylov_cbind -lpsb_prec_cbind -lpsb_base_cbind
|
||||
# -lpsb_linsolve_cbind -lpsb_prec_cbind -lpsb_base_cbind
|
||||
PSBC_LIBS= -L$(PSBLAS_LIBDIR) -lpsb_cbind -lpsb_linsolve -lpsb_prec
|
||||
AMGC_LIBS=-L$(LIBDIR) -lamg_cbind -lamg_prec
|
||||
#
|
||||
@@ -23,16 +23,21 @@ EXEDIR=./runs
|
||||
#UMFLIBS=-lumfpack -lamd -lcholmod -lcolamd -lcamd -lccolamd -L/usr/include/suitesparse
|
||||
#UMFFLAGS=-DHave_UMF_ -I/usr/include/suitesparse
|
||||
|
||||
all: amgec
|
||||
all: amgec amgecgpu
|
||||
|
||||
amgec: amgec.o
|
||||
$(MPFC) amgec.o -o amgec $(AMGC_LIBS) $(PSBC_LIBS) $(PSBCLDLIBS) $(PSBLAS_LIBS) \
|
||||
$(UMFLIBS) $(PSBLDLIBS) $(LDLIBS) -lm -lgfortran
|
||||
$(UMFLIBS) $(PSBLDLIBS) $(AMGLDLIBS) $(PSBGPULDLIBS) $(LDLIBS) -lm -lgfortran -fopenmp
|
||||
# \
|
||||
# -lifcore -lifcoremt -lguide -limf -lirc -lintlc -lcxaguard -L/opt/intel/fc/10.0.023/lib/ -lm
|
||||
|
||||
/bin/mv amgec $(EXEDIR)
|
||||
|
||||
amgecgpu: amgecgpu.o
|
||||
$(MPFC) amgecgpu.o -o amgecgpu $(AMGC_LIBS) $(PSBC_LIBS) $(PSBCLDLIBS) $(PSBLAS_LIBS) \
|
||||
$(UMFLIBS) $(PSBLDLIBS) $(AMGLDLIBS) $(PSBGPULDLIBS) $(LDLIBS) -lm -lgfortran -fopenmp
|
||||
/bin/mv amgecgpu $(EXEDIR)
|
||||
|
||||
.f90.o:
|
||||
$(MPFC) $(F90COPT) $(FINCLUDES) $(FDEFINES) -c $<
|
||||
.c.o:
|
||||
@@ -40,7 +45,7 @@ amgec: amgec.o
|
||||
|
||||
|
||||
clean:
|
||||
/bin/rm -f amgec.o $(EXEDIR)/amgec
|
||||
/bin/rm -f amgec.o $(EXEDIR)/amgec $(EXEDIR)/amgecgpu
|
||||
verycleanlib:
|
||||
(cd ../..; make veryclean)
|
||||
lib:
|
||||
@@ -48,5 +53,6 @@ lib:
|
||||
|
||||
tests: all
|
||||
cd runs ; ./amgec < amge.inp
|
||||
cd runs ; ./amgecgpu < amgegpu.inp
|
||||
|
||||
|
||||
|
||||
@@ -358,6 +358,25 @@ int main(int argc, char *argv[])
|
||||
fprintf(stderr,"From smoothers_build: %d\n",ret);
|
||||
|
||||
psb_c_barrier(*cctxt);
|
||||
/* Do a dry run of the preconditioner */
|
||||
info = amg_c_dprecapply(ph,bh,xh,cdh);
|
||||
if (info != 0) {
|
||||
fprintf(stderr,"From dprec_apply: %d\nBailing out\n",info);
|
||||
psb_c_abort(*cctxt);
|
||||
}
|
||||
/* Do a dry run of the preconditioner with the option routine */
|
||||
info = amg_c_dprecapply_opt(ph,bh,xh,cdh,"N");
|
||||
if (info != 0) {
|
||||
fprintf(stderr,"From dprec_apply_opt: %d\nBailing out\n",info);
|
||||
psb_c_abort(*cctxt);
|
||||
}
|
||||
/*
|
||||
info = amg_c_dprecapply_opt(ph,bh,xh,cdh,"T");
|
||||
if (info != 0) {
|
||||
fprintf(stderr,"From dprec_apply_opt: %d\nBailing out\n",info);
|
||||
psb_c_abort(*cctxt);
|
||||
}
|
||||
*/
|
||||
/* Set up the solver options */
|
||||
psb_c_DefaultSolverOptions(&options);
|
||||
options.eps = 1.e-6;
|
||||
|
||||
@@ -0,0 +1,679 @@
|
||||
/*----------------------------------------------------------------------------------*/
|
||||
/* Parallel Sparse BLAS v2.2 */
|
||||
/* (C) Copyright 2007 Salvatore Filippone University of Rome Tor Vergata */
|
||||
/* */
|
||||
/* Redistribution and use in source and binary forms, with or without */
|
||||
/* modification, are permitted provided that the following conditions */
|
||||
/* are met: */
|
||||
/* 1. Redistributions of source code must retain the above copyright */
|
||||
/* notice, this list of conditions and the following disclaimer. */
|
||||
/* 2. Redistributions in binary form must reproduce the above copyright */
|
||||
/* notice, this list of conditions, and the following disclaimer in the */
|
||||
/* documentation and/or other materials provided with the distribution. */
|
||||
/* 3. The name of the PSBLAS group or the names of its contributors may */
|
||||
/* not be used to endorse or promote products derived from this */
|
||||
/* software without specific written permission. */
|
||||
/* */
|
||||
/* THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS */
|
||||
/* ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED */
|
||||
/* TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR */
|
||||
/* PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PSBLAS GROUP OR ITS CONTRIBUTORS */
|
||||
/* BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR */
|
||||
/* CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF */
|
||||
/* SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS */
|
||||
/* INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN */
|
||||
/* CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) */
|
||||
/* ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE */
|
||||
/* POSSIBILITY OF SUCH DAMAGE. */
|
||||
/* */
|
||||
/* */
|
||||
/* File: ppdec.c */
|
||||
/* */
|
||||
/* Program: ppdec */
|
||||
/* This sample program shows how to build and solve a sparse linear */
|
||||
/* */
|
||||
/* The program solves a linear system based on the partial differential */
|
||||
/* equation */
|
||||
/* */
|
||||
/* */
|
||||
/* */
|
||||
/* The equation generated is */
|
||||
/* */
|
||||
/* b1 d d (u) b2 d d (u) a1 d (u)) a2 d (u))) */
|
||||
/* - ------ - ------ + ----- + ------ + a3 u = 0 */
|
||||
/* dx dx dy dy dx dy */
|
||||
/* */
|
||||
/* */
|
||||
/* with Dirichlet boundary conditions on the unit cube */
|
||||
/* */
|
||||
/* 0<=x,y,z<=1 */
|
||||
/* */
|
||||
/* The equation is discretized with finite differences and uniform stepsize; */
|
||||
/* the resulting discrete equation is */
|
||||
/* */
|
||||
/* ( u(x,y,z)(2b1+2b2+a1+a2)+u(x-1,y)(-b1-a1)+u(x,y-1)(-b2-a2)+ */
|
||||
/* -u(x+1,y)b1-u(x,y+1)b2)*(1/h**2) */
|
||||
/* */
|
||||
/* Example adapted from: C.T.Kelley */
|
||||
/* Iterative Methods for Linear and Nonlinear Equations */
|
||||
/* SIAM 1995 */
|
||||
/* */
|
||||
/* */
|
||||
/* In this sample program the index space of the discretized */
|
||||
/* computational domain is first numbered sequentially in a standard way, */
|
||||
/* then the corresponding vector is distributed according to an HPF BLOCK */
|
||||
/* distribution directive. */
|
||||
/* */
|
||||
/* Boundary conditions are set in a very simple way, by adding */
|
||||
/* equations of the form */
|
||||
/* */
|
||||
/* u(x,y) = rhs(x,y) */
|
||||
/* */
|
||||
/*----------------------------------------------------------------------------------*/
|
||||
|
||||
#include <stdio.h>
|
||||
#include <stdlib.h>
|
||||
#include <string.h>
|
||||
#include <math.h>
|
||||
|
||||
#include "psb_base_cbind.h"
|
||||
#include "amg_cbind.h"
|
||||
|
||||
double a1(double x, double y, double z)
|
||||
{
|
||||
return (1.0 / 80.0);
|
||||
}
|
||||
double a2(double x, double y, double z)
|
||||
{
|
||||
return (1.0 / 80.0);
|
||||
}
|
||||
double a3(double x, double y, double z)
|
||||
{
|
||||
return (1.0 / 80.0);
|
||||
}
|
||||
double c(double x, double y, double z)
|
||||
{
|
||||
return (0.0);
|
||||
}
|
||||
double b1(double x, double y, double z)
|
||||
{
|
||||
return (0.0 / sqrt(3.0));
|
||||
}
|
||||
double b2(double x, double y, double z)
|
||||
{
|
||||
return (0.0 / sqrt(3.0));
|
||||
}
|
||||
double b3(double x, double y, double z)
|
||||
{
|
||||
return (0.0 / sqrt(3.0));
|
||||
}
|
||||
|
||||
double g(double x, double y, double z)
|
||||
{
|
||||
if (x == 1.0)
|
||||
{
|
||||
return (1.0);
|
||||
}
|
||||
else if (x == 0.0)
|
||||
{
|
||||
return (exp(-y * y - z * z));
|
||||
}
|
||||
else
|
||||
{
|
||||
return (0.0);
|
||||
}
|
||||
}
|
||||
|
||||
#define NBMAX 20
|
||||
|
||||
psb_i_t matgen(psb_c_ctxt cctxt, psb_i_t nl, psb_i_t idim, psb_l_t vl[],
|
||||
psb_c_dspmat *ah, const char *afmt,
|
||||
psb_c_descriptor *cdh, const char *cdfmt,
|
||||
psb_c_dvector *xh, psb_c_dvector *bh, psb_c_dvector *rh)
|
||||
{
|
||||
psb_i_t iam, np;
|
||||
psb_l_t ix, iy, iz, el, glob_row;
|
||||
psb_i_t i, k, info, ret;
|
||||
double x, y, z, deltah, sqdeltah, deltah2;
|
||||
double val[10 * NBMAX], zt[NBMAX];
|
||||
psb_l_t irow[10 * NBMAX], icol[10 * NBMAX];
|
||||
|
||||
info = 0;
|
||||
psb_c_info(cctxt, &iam, &np);
|
||||
|
||||
if (iam == 0)
|
||||
{
|
||||
fprintf(stdout, "Starting matrix generation: local number of rows %d\n", nl);
|
||||
fprintf(stdout, "Matrix format: %s\n", afmt);
|
||||
fprintf(stdout, "Descriptor format: %s\n", cdfmt);
|
||||
fflush(stdout);
|
||||
}
|
||||
fprintf(stderr, "Matrix generation: local number of rows %d on process %d\n", nl, iam);
|
||||
|
||||
deltah = (double)1.0 / (idim + 1);
|
||||
sqdeltah = deltah * deltah;
|
||||
deltah2 = 2.0 * deltah;
|
||||
psb_c_set_index_base(0);
|
||||
for (i = 0; i < nl; i++)
|
||||
{
|
||||
glob_row = vl[i];
|
||||
// if ((i%100000 == 0)||(i<10)) fprintf(stderr,"%d: generation loop at %d %ld \n",iam,i,glob_row);
|
||||
el = 0;
|
||||
ix = glob_row / (idim * idim);
|
||||
iy = (glob_row - ix * idim * idim) / idim;
|
||||
iz = glob_row - ix * idim * idim - iy * idim;
|
||||
x = (ix + 1) * deltah;
|
||||
y = (iy + 1) * deltah;
|
||||
z = (iz + 1) * deltah;
|
||||
zt[0] = 0.0;
|
||||
/* internal point: build discretization */
|
||||
/* term depending on (x-1,y,z) */
|
||||
val[el] = -a1(x, y, z) / sqdeltah - b1(x, y, z) / deltah2;
|
||||
if (ix == 0)
|
||||
{
|
||||
zt[0] += g(0.0, y, z) * (-val[el]);
|
||||
}
|
||||
else
|
||||
{
|
||||
icol[el] = (ix - 1) * idim * idim + (iy)*idim + (iz);
|
||||
el = el + 1;
|
||||
}
|
||||
/* term depending on (x,y-1,z) */
|
||||
val[el] = -a2(x, y, z) / sqdeltah - b2(x, y, z) / deltah2;
|
||||
if (iy == 0)
|
||||
{
|
||||
zt[0] += g(x, 0.0, z) * (-val[el]);
|
||||
}
|
||||
else
|
||||
{
|
||||
icol[el] = (ix)*idim * idim + (iy - 1) * idim + (iz);
|
||||
el = el + 1;
|
||||
}
|
||||
/* term depending on (x,y,z-1)*/
|
||||
val[el] = -a3(x, y, z) / sqdeltah - b3(x, y, z) / deltah2;
|
||||
if (iz == 0)
|
||||
{
|
||||
zt[0] += g(x, y, 0.0) * (-val[el]);
|
||||
}
|
||||
else
|
||||
{
|
||||
icol[el] = (ix)*idim * idim + (iy)*idim + (iz - 1);
|
||||
el = el + 1;
|
||||
}
|
||||
/* term depending on (x,y,z)*/
|
||||
val[el] = 2.0 * (a1(x, y, z) + a2(x, y, z) + a3(x, y, z)) / sqdeltah + c(x, y, z);
|
||||
icol[el] = (ix)*idim * idim + (iy)*idim + (iz);
|
||||
el = el + 1;
|
||||
/* term depending on (x,y,z+1) */
|
||||
val[el] = -a3(x, y, z) / sqdeltah + b3(x, y, z) / deltah2;
|
||||
if (iz == idim - 1)
|
||||
{
|
||||
zt[0] += g(x, y, 1.0) * (-val[el]);
|
||||
}
|
||||
else
|
||||
{
|
||||
icol[el] = (ix)*idim * idim + (iy)*idim + (iz + 1);
|
||||
el = el + 1;
|
||||
}
|
||||
/* term depending on (x,y+1,z) */
|
||||
val[el] = -a2(x, y, z) / sqdeltah + b2(x, y, z) / deltah2;
|
||||
if (iy == idim - 1)
|
||||
{
|
||||
zt[0] += g(x, 1.0, z) * (-val[el]);
|
||||
}
|
||||
else
|
||||
{
|
||||
icol[el] = (ix)*idim * idim + (iy + 1) * idim + (iz);
|
||||
el = el + 1;
|
||||
}
|
||||
/* term depending on (x+1,y,z) */
|
||||
val[el] = -a1(x, y, z) / sqdeltah + b1(x, y, z) / deltah2;
|
||||
if (ix == idim - 1)
|
||||
{
|
||||
zt[0] += g(1.0, y, z) * (-val[el]);
|
||||
}
|
||||
else
|
||||
{
|
||||
icol[el] = (ix + 1) * idim * idim + (iy)*idim + (iz);
|
||||
el = el + 1;
|
||||
}
|
||||
for (k = 0; k < el; k++)
|
||||
irow[k] = glob_row;
|
||||
if ((ret = psb_c_dspins(el, irow, icol, val, ah, cdh)) != 0)
|
||||
fprintf(stderr, "From psb_c_dspins: %d\n", ret);
|
||||
irow[0] = glob_row;
|
||||
psb_c_dgeins(1, irow, zt, bh, cdh);
|
||||
zt[0] = 0.0;
|
||||
psb_c_dgeins(1, irow, zt, xh, cdh);
|
||||
}
|
||||
|
||||
#ifdef PSB_HAVE_CUDA
|
||||
/* Execute assembly and final allocation on CUDA device */
|
||||
info = psb_c_cdasb_format(cdh, cdfmt);
|
||||
if (info != 0)
|
||||
{
|
||||
return (info);
|
||||
}
|
||||
#ifdef DEBUG
|
||||
else if (iam == 0)
|
||||
{
|
||||
fprintf(stdout, "Completed descriptor assembly format\n");
|
||||
fflush(stdout);
|
||||
}
|
||||
#endif
|
||||
info = psb_c_dspasb_opt(ah, cdh, afmt, PSB_UPD_DFLT, PSB_DUPL_DEF);
|
||||
if (info != 0)
|
||||
{
|
||||
return (info);
|
||||
}
|
||||
#ifdef DEBUG
|
||||
else if (iam == 0)
|
||||
{
|
||||
fprintf(stdout, "Completed matrix assembly\n");
|
||||
fflush(stdout);
|
||||
}
|
||||
#endif
|
||||
info = psb_c_dgeasb_options_format(xh, cdh, PSB_DUPL_ADD, cdfmt);
|
||||
if (info != 0)
|
||||
{
|
||||
return (info);
|
||||
}
|
||||
#ifdef DEBUG
|
||||
else if (iam == 0)
|
||||
{
|
||||
fprintf(stdout, "Completed x vector assembly\n");
|
||||
fflush(stdout);
|
||||
}
|
||||
#endif
|
||||
info = psb_c_dgeasb_options_format(bh, cdh, PSB_DUPL_ADD, cdfmt);
|
||||
if (info != 0)
|
||||
{
|
||||
return (info);
|
||||
}
|
||||
#ifdef DEBUG
|
||||
else if (iam == 0)
|
||||
{
|
||||
fprintf(stdout, "Completed b vector assembly\n");
|
||||
fflush(stdout);
|
||||
}
|
||||
#endif
|
||||
info = psb_c_dgeasb_options_format(rh, cdh, PSB_DUPL_ADD, cdfmt);
|
||||
if (info != 0)
|
||||
{
|
||||
return (info);
|
||||
}
|
||||
#ifdef DEBUG
|
||||
else if (iam == 0)
|
||||
{
|
||||
fprintf(stdout, "Completed r vector assembly\n");
|
||||
fflush(stdout);
|
||||
}
|
||||
#endif
|
||||
#else
|
||||
/* Execute assembly and final allocation HOST side */
|
||||
if ((info = psb_c_cdasb(cdh)) != 0)
|
||||
return (info);
|
||||
|
||||
if ((info = psb_c_dspasb(ah, cdh)) != 0)
|
||||
return (info);
|
||||
|
||||
if ((info = psb_c_dgeasb(xh, cdh)) != 0)
|
||||
return (info);
|
||||
if ((info = psb_c_dgeasb(bh, cdh)) != 0)
|
||||
return (info);
|
||||
if ((info = psb_c_dgeasb(rh, cdh)) != 0)
|
||||
return (info);
|
||||
return (info);
|
||||
#endif
|
||||
}
|
||||
|
||||
#define LINEBUFSIZE 1024
|
||||
static char buffer[LINEBUFSIZE + 1];
|
||||
int get_buffer(FILE *fp)
|
||||
{
|
||||
while (!feof(fp))
|
||||
{
|
||||
fgets(buffer, LINEBUFSIZE, fp);
|
||||
if (buffer[0] != '%')
|
||||
break;
|
||||
}
|
||||
}
|
||||
void get_iparm(FILE *fp, int *val)
|
||||
{
|
||||
get_buffer(fp);
|
||||
// fprintf(stderr,"Reading int parm: %s\n",buffer);
|
||||
sscanf(buffer, "%d ", val);
|
||||
}
|
||||
void get_dparm(FILE *fp, double *val)
|
||||
{
|
||||
get_buffer(fp);
|
||||
sscanf(buffer, "%lf ", val);
|
||||
}
|
||||
void get_hparm(FILE *fp, char *val)
|
||||
{
|
||||
get_buffer(fp);
|
||||
sscanf(buffer, "%s ", val);
|
||||
}
|
||||
|
||||
#define DUMPMATRIX 0
|
||||
|
||||
int main(int argc, char *argv[])
|
||||
{
|
||||
psb_c_ctxt *cctxt;
|
||||
psb_i_t iam, np;
|
||||
char methd[40], ptype[40], afmt[8], cdfmt[8];
|
||||
psb_i_t nparms;
|
||||
psb_i_t idim, info, istop, itmax, itrace, irst, iter, ret;
|
||||
amg_c_dprec *ph;
|
||||
psb_c_dspmat *ah;
|
||||
psb_c_dvector *bh, *xh, *rh;
|
||||
psb_i_t nb, nlr, nl;
|
||||
psb_l_t i, ng, *vl, k;
|
||||
double t1, t2, eps, err;
|
||||
double *xv, *bv, *rv;
|
||||
double one = 1.0, zero = 0.0, res2;
|
||||
psb_c_SolverOptions options;
|
||||
psb_c_descriptor *cdh;
|
||||
FILE *vectfile;
|
||||
|
||||
cctxt = psb_c_new_ctxt();
|
||||
psb_c_init(cctxt);
|
||||
#ifdef PSB_HAVE_CUDA
|
||||
psb_c_cuda_init(cctxt);
|
||||
#endif
|
||||
psb_c_info(*cctxt, &iam, &np);
|
||||
#ifdef PSB_HAVE_CUDA
|
||||
if (iam == 0)
|
||||
{
|
||||
fprintf(stderr, "-- CUDA initialized --\n");
|
||||
fprintf(stderr, "Number of available GPU devices: %d\n", psb_c_cuda_getDeviceCount());
|
||||
}
|
||||
#endif
|
||||
fprintf(stdout, "Initialization: am %d of %d\n", iam, np);
|
||||
|
||||
fflush(stdout);
|
||||
psb_c_barrier(*cctxt);
|
||||
if (iam == 0)
|
||||
{
|
||||
get_iparm(stdin, &nparms);
|
||||
get_hparm(stdin, methd);
|
||||
get_hparm(stdin, ptype);
|
||||
get_hparm(stdin, afmt);
|
||||
get_hparm(stdin, cdfmt);
|
||||
get_iparm(stdin, &idim);
|
||||
get_iparm(stdin, &istop);
|
||||
get_iparm(stdin, &itmax);
|
||||
get_iparm(stdin, &itrace);
|
||||
get_iparm(stdin, &irst);
|
||||
|
||||
#if 0
|
||||
/* Display paremeters */
|
||||
fprintf(stderr, "Input parameters:\n");
|
||||
fprintf(stderr, " Number of parameters: %d\n", nparms);
|
||||
fprintf(stderr, " Method: %s\n", methd);
|
||||
fprintf(stderr, " Preconditioner type: %s\n", ptype);
|
||||
fprintf(stderr, " Matrix format: %s\n", afmt);
|
||||
fprintf(stderr, " Descriptor format: %s\n", cdfmt);
|
||||
fprintf(stderr, " Problem dimension: %d\n", idim);
|
||||
fprintf(stderr, " Stopping criterion: %d\n", istop);
|
||||
fprintf(stderr, " Maximum iterations: %d\n", itmax);
|
||||
fprintf(stderr, " Trace frequency: %d\n", itrace);
|
||||
fprintf(stderr, " Restart depth: %d\n", irst);
|
||||
#endif
|
||||
}
|
||||
/* Now broadcast the values, and check they're OK */
|
||||
psb_c_ibcast(*cctxt, 1, &nparms, 0);
|
||||
psb_c_hbcast(*cctxt, methd, 0);
|
||||
psb_c_hbcast(*cctxt, ptype, 0);
|
||||
psb_c_hbcast(*cctxt, afmt, 0);
|
||||
psb_c_hbcast(*cctxt, cdfmt, 0);
|
||||
psb_c_ibcast(*cctxt, 1, &idim, 0);
|
||||
psb_c_ibcast(*cctxt, 1, &istop, 0);
|
||||
psb_c_ibcast(*cctxt, 1, &itmax, 0);
|
||||
psb_c_ibcast(*cctxt, 1, &itrace, 0);
|
||||
psb_c_ibcast(*cctxt, 1, &irst, 0);
|
||||
|
||||
psb_c_barrier(*cctxt);
|
||||
|
||||
cdh = psb_c_new_descriptor();
|
||||
psb_c_set_index_base(0);
|
||||
|
||||
/* Simple minded BLOCK data distribution */
|
||||
ng = ((psb_l_t)idim) * idim * idim;
|
||||
nb = (ng + np - 1) / np;
|
||||
nl = nb;
|
||||
if ((ng - iam * nb) < nl)
|
||||
nl = ng - iam * nb;
|
||||
fprintf(stderr, "%d: Input data %d %ld %d %d\n", iam, idim, ng, nb, nl);
|
||||
if ((vl = malloc(nb * sizeof(psb_l_t))) == NULL)
|
||||
{
|
||||
fprintf(stderr, "On %d: malloc failure\n", iam);
|
||||
psb_c_abort(*cctxt);
|
||||
}
|
||||
i = ((psb_l_t)iam) * nb;
|
||||
for (k = 0; k < nl; k++)
|
||||
vl[k] = i + k;
|
||||
|
||||
if ((info = psb_c_cdall_vl(nl, vl, *cctxt, cdh)) != 0)
|
||||
{
|
||||
fprintf(stderr, "From cdall: %d\nBailing out\n", info);
|
||||
psb_c_abort(*cctxt);
|
||||
}
|
||||
|
||||
bh = psb_c_new_dvector();
|
||||
xh = psb_c_new_dvector();
|
||||
rh = psb_c_new_dvector();
|
||||
ah = psb_c_new_dspmat();
|
||||
// fprintf(stderr,"From psb_c_new_dspmat: %p\n",ah);
|
||||
|
||||
/* Allocate mem space for sparse matrix and vectors */
|
||||
ret = psb_c_dspall(ah, cdh);
|
||||
// fprintf(stderr,"From psb_c_dspall: %d\n",ret);
|
||||
psb_c_dgeall(bh, cdh);
|
||||
psb_c_dgeall(xh, cdh);
|
||||
psb_c_dgeall(rh, cdh);
|
||||
|
||||
if (iam == 0)
|
||||
{
|
||||
fprintf(stdout, "Matrix and vectors allocated\n");
|
||||
}
|
||||
psb_c_barrier(*cctxt);
|
||||
|
||||
/* Matrix generation */
|
||||
if (matgen(*cctxt, nl, idim, vl, ah, afmt, cdh, cdfmt, xh, bh, rh) != 0)
|
||||
{
|
||||
fprintf(stderr, "Error during matrix build loop\n");
|
||||
psb_c_abort(*cctxt);
|
||||
}
|
||||
psb_c_barrier(*cctxt);
|
||||
#if 0
|
||||
if (iam == 0)
|
||||
{
|
||||
fprintf(stdout, "Matrix and vectors generated\n");
|
||||
}
|
||||
#endif
|
||||
fflush(stdout);
|
||||
/* Set up the preconditioner */
|
||||
ph = amg_c_dprec_new();
|
||||
amg_c_dprecinit(*cctxt, ph, ptype);
|
||||
amg_c_dprecsetc(ph, "SMOOTHER_TYPE", "L1-JACOBI");
|
||||
amg_c_dprecseti(ph, "SMOOTHER_SWEEPS", 2);
|
||||
amg_c_dprecsetc(ph, "COARSE_SOLVE", "BJAC");
|
||||
amg_c_dprecsetc(ph, "COARSE_SUBSOLVE", "L1-JACOBI");
|
||||
amg_c_dprecsetc(ph, "AGGR_FILTER", "FILTER");
|
||||
if ((ret = amg_c_dhierarchy_build(ah, cdh, ph)) != 0){
|
||||
fprintf(stderr, "From hierarchy_build: %d\n", ret);
|
||||
}{
|
||||
#if 0
|
||||
if (iam == 0) {
|
||||
fprintf(stdout, "Hierarchy built\n");
|
||||
}
|
||||
#endif
|
||||
}
|
||||
#if defined (PSB_HAVE_CUDA)
|
||||
if ((ret = amg_c_dsmoothers_build_opt(ah, cdh, ph, afmt, cdfmt)) != 0)
|
||||
fprintf(stderr, "From smoothers_build_format: %d\n", ret);
|
||||
#else
|
||||
if ((ret = amg_c_dsmoothers_build(ah, cdh, ph)) != 0)
|
||||
fprintf(stderr, "From smoothers_build: %d\n", ret);
|
||||
#endif
|
||||
#if 0
|
||||
if ( ret == 0){
|
||||
if (iam == 0) {
|
||||
fprintf(stdout, "Smoothers built\n");
|
||||
}
|
||||
}
|
||||
#endif
|
||||
|
||||
#ifdef PSB_HAVE_CUDA
|
||||
/* Allocate work vectors for the preconditioner on the GPU */
|
||||
info = amg_c_dallocate_wrk(ph, cdfmt);
|
||||
if (info != 0)
|
||||
{
|
||||
fprintf(stderr, "From dallocate_wrk: %d\nBailing out\n", info);
|
||||
psb_c_abort(*cctxt);
|
||||
} else {
|
||||
if (iam == 0) {
|
||||
fprintf(stdout, "Preconditioner work vectors allocated\n");
|
||||
}
|
||||
}
|
||||
#endif
|
||||
|
||||
psb_c_barrier(*cctxt);
|
||||
/* Do a dry run of the preconditioner */
|
||||
info = amg_c_dprecapply(ph, bh, xh, cdh);
|
||||
if (info != 0)
|
||||
{
|
||||
fprintf(stderr, "From dprec_apply: %d\nBailing out\n", info);
|
||||
psb_c_abort(*cctxt);
|
||||
}
|
||||
/* Do a dry run of the preconditioner with the option routine */
|
||||
info = amg_c_dprecapply_opt(ph, bh, xh, cdh, "N");
|
||||
if (info != 0)
|
||||
{
|
||||
fprintf(stderr, "From dprec_apply_opt: %d\nBailing out\n", info);
|
||||
psb_c_abort(*cctxt);
|
||||
}
|
||||
/*
|
||||
info = amg_c_dprecapply_opt(ph,bh,xh,cdh,"T");
|
||||
if (info != 0) {
|
||||
fprintf(stderr,"From dprec_apply_opt: %d\nBailing out\n",info);
|
||||
psb_c_abort(*cctxt);
|
||||
}
|
||||
*/
|
||||
/* Print the information on the preconditioner */
|
||||
if (iam == 0)
|
||||
{
|
||||
info = amg_c_ddescr(ph);
|
||||
if (info != 0)
|
||||
{
|
||||
fprintf(stderr, "From ddescr: %d\nBailing out\n", info);
|
||||
psb_c_abort(*cctxt);
|
||||
}
|
||||
}
|
||||
|
||||
/* Set up the solver options */
|
||||
psb_c_DefaultSolverOptions(&options);
|
||||
options.eps = 1.e-6;
|
||||
options.itmax = itmax;
|
||||
options.irst = irst;
|
||||
options.itrace = 1;
|
||||
options.istop = istop;
|
||||
psb_c_seterraction_ret();
|
||||
t1 = psb_c_wtime();
|
||||
ret = amg_c_dkrylov(methd, ah, ph, bh, xh, cdh, &options);
|
||||
t2 = psb_c_wtime();
|
||||
iter = options.iter;
|
||||
err = options.err;
|
||||
// fprintf(stderr,"From krylov: %d %lf, %d %d\n",iter,err,ret,psb_c_get_errstatus());
|
||||
if (psb_c_get_errstatus() != 0)
|
||||
{
|
||||
psb_c_print_errmsg();
|
||||
}
|
||||
// fprintf(stderr,"After cleanup %d\n",psb_c_get_errstatus());
|
||||
/* Check 2-norm of residual on exit */
|
||||
psb_c_dgeaxpby(one, bh, zero, rh, cdh);
|
||||
psb_c_dspmm(-one, ah, xh, one, rh, cdh);
|
||||
res2 = psb_c_dgenrm2(rh, cdh);
|
||||
|
||||
if (iam == 0)
|
||||
{
|
||||
fprintf(stdout, "Time: %lf\n", (t2 - t1));
|
||||
fprintf(stdout, "Iter: %d\n", iter);
|
||||
fprintf(stdout, "Err: %lg\n", err);
|
||||
fprintf(stdout, "||r||_2: %lg\n", res2);
|
||||
}
|
||||
|
||||
#if DUMPATRIX
|
||||
psb_c_dmat_name_print(ah, "cbindmat.mtx");
|
||||
nlr = psb_c_cd_get_local_rows(cdh);
|
||||
bv = psb_c_dvect_get_cpy(bh);
|
||||
vectfile = fopen("cbindb.mtx", "w");
|
||||
for (i = 0; i < nlr; i++)
|
||||
fprintf(vectfile, "%lf\n", bv[i]);
|
||||
fclose(vectfile);
|
||||
|
||||
xv = psb_c_dvect_get_cpy(xh);
|
||||
nlr = psb_c_cd_get_local_rows(cdh);
|
||||
for (i = 0; i < nlr; i++)
|
||||
fprintf(stdout, "SOL: %d %d %lf\n", iam, i, xv[i]);
|
||||
|
||||
rv = psb_c_dvect_get_cpy(rh);
|
||||
nlr = psb_c_cd_get_local_rows(cdh);
|
||||
for (i = 0; i < nlr; i++)
|
||||
fprintf(stdout, "RES: %d %d %lf\n", iam, i, rv[i]);
|
||||
|
||||
#endif
|
||||
|
||||
/* Clean up memory */
|
||||
if ((info = psb_c_dgefree(xh, cdh)) != 0)
|
||||
{
|
||||
fprintf(stderr, "From dgefree: %d\nBailing out\n", info);
|
||||
psb_c_abort(*cctxt);
|
||||
}
|
||||
#if 0
|
||||
fprintf(stderr, "after dgefree xh\n");
|
||||
#endif
|
||||
if ((info = psb_c_dgefree(bh, cdh)) != 0)
|
||||
{
|
||||
fprintf(stderr, "From dgefree: %d\nBailing out\n", info);
|
||||
psb_c_abort(*cctxt);
|
||||
}
|
||||
#if 0
|
||||
fprintf(stderr, "after dgefree bh\n");
|
||||
#endif
|
||||
if ((info = psb_c_dgefree(rh, cdh)) != 0)
|
||||
{
|
||||
fprintf(stderr, "From dgefree: %d\nBailing out\n", info);
|
||||
psb_c_abort(*cctxt);
|
||||
}
|
||||
#if 0
|
||||
fprintf(stderr, "after dgefree rh\n");
|
||||
#endif
|
||||
if ((info = psb_c_cdfree(cdh)) != 0)
|
||||
{
|
||||
fprintf(stderr, "From cdfree: %d\nBailing out\n", info);
|
||||
psb_c_abort(*cctxt);
|
||||
}
|
||||
#if 0
|
||||
fprintf(stderr, "after cdfree\n");
|
||||
#endif
|
||||
// fprintf(stderr,"pointer from cdfree: %p\n",cdh->descriptor);
|
||||
|
||||
/* Clean up object handles */
|
||||
free(ph);
|
||||
free(xh);
|
||||
free(bh);
|
||||
free(ah);
|
||||
free(cdh);
|
||||
|
||||
if (iam == 0)
|
||||
fprintf(stderr, "program completed successfully\n");
|
||||
|
||||
#ifdef PSB_HAVE_CUDA
|
||||
psb_c_cuda_exit();
|
||||
#endif
|
||||
psb_c_barrier(*cctxt);
|
||||
psb_c_exit(*cctxt);
|
||||
free(cctxt);
|
||||
}
|
||||
@@ -0,0 +1,10 @@
|
||||
9 Number of entries below this
|
||||
BICGSTAB Iterative method BICGSTAB CGS BICG BICGSTABL RGMRES
|
||||
ML Preconditioner NONE DIAG BJAC
|
||||
HLG A Storage format CSR COO JAD (HOST) CSRG HLG (GPU)
|
||||
DEVICE Communication format CSR COO JAD (HOST) CSRG HLG (GPU)
|
||||
60 Domain size (acutal system is this**3)
|
||||
1 Stopping criterion
|
||||
80 MAXIT
|
||||
01 ITRACE
|
||||
20 IRST restart for RGMRES and BiCGSTABL
|
||||
+25
-6
@@ -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
|
||||
|
||||
|
||||
+8
-6
@@ -129,10 +129,10 @@ dnl We set our own FC flags, ignore those from AC_PROG_FC but not those from the
|
||||
dnl environment variable. Same for C
|
||||
dnl
|
||||
save_FCFLAGS="$FCFLAGS";
|
||||
AC_PROG_FC([ftn xlf2003_r xlf2003 xlf95_r xlf95 xlf90 xlf pgf95 pgf90 ifx ifort ifc nagfor gfortran])
|
||||
AC_PROG_FC([ftn xlf2003_r xlf2003 xlf95_r xlf95 xlf90 xlf pgf95 pgf90 flang ifx ifort ifc nagfor gfortran])
|
||||
FCFLAGS="$save_FCFLAGS";
|
||||
save_CFLAGS="$CFLAGS";
|
||||
AC_PROG_CC([cc xlc pgcc icx icc gcc ])
|
||||
AC_PROG_CC([cc xlc pgcc clang icx icc gcc ])
|
||||
if test "x$ac_cv_prog_cc_stdc" == "xno" ; then
|
||||
AC_MSG_ERROR([Problem : Need a C99 compiler ! ])
|
||||
else
|
||||
@@ -140,7 +140,7 @@ else
|
||||
fi
|
||||
CFLAGS="$save_CFLAGS";
|
||||
save_CXXFLAGS="$CXXFLAGS";
|
||||
AC_PROG_CXX([CC xlc++ icpx icpc g++])
|
||||
AC_PROG_CXX([CC xlc++ clang++ icpx icpc g++])
|
||||
CXXFLAGS="$save_CXXFLAGS";
|
||||
dnl AC_PROG_CXX
|
||||
|
||||
@@ -587,8 +587,8 @@ if test "x$pac_cv_psblas_patchlevel" == "xunknown"; then
|
||||
AC_MSG_ERROR([PSBLAS patchlevel "$pac_cv_psblas_patchlevel".])
|
||||
fi
|
||||
if (( $pac_cv_psblas_major < 3 )) ||
|
||||
( (( $pac_cv_psblas_major == 3 )) && (( $pac_cv_psblas_minor < 8 ))) ; then
|
||||
AC_MSG_ERROR([I need at least PSBLAS version 3.8.0])
|
||||
( (( $pac_cv_psblas_major == 3 )) && (( $pac_cv_psblas_minor < 9 ))) ; then
|
||||
AC_MSG_ERROR([I need at least PSBLAS version 3.9.0])
|
||||
else
|
||||
AC_MSG_NOTICE([Am configuring with PSBLAS version $pac_cv_psblas_major.$pac_cv_psblas_minor.$pac_cv_psblas_patchlevel.])
|
||||
fi
|
||||
@@ -792,7 +792,7 @@ if test "x$amg4psblas_cv_have_superlu" == "xyes" ; then
|
||||
SLU_FLAGS="-DAMG_SLU_VERSION_$pac_slu_version $SLU_INCLUDES"
|
||||
FDEFINES="$amg_cv_define_prepend-DAMG_HAVE_SLU $FDEFINES"
|
||||
CHAVESLU="#define AMG_HAVE_SLU"
|
||||
CSLUVERSION="#define AMG_SLU_VERSION_$pac_slu_version"
|
||||
CSLUVERSION="#define AMG_SLU_VERSION $pac_slu_version"
|
||||
else
|
||||
SLU_FLAGS=""
|
||||
fi
|
||||
@@ -889,6 +889,8 @@ AC_MSG_NOTICE([
|
||||
SuperLU_Dist detected : ${amg4psblas_cv_have_superludist}
|
||||
UMFPack detected : ${amg4psblas_cv_have_umfpack}
|
||||
|
||||
INSTALL_DIR : ${INSTALL_DIR}
|
||||
|
||||
If you are satisfied, run 'make' to build ${PACKAGE_NAME} and its documentation; otherwise
|
||||
type ./configure --help=short for a complete list of configure options specific to ${PACKAGE_NAME}.
|
||||
dnl To install the program and its documentation, run 'make install' if you are root,
|
||||
|
||||
-12410
File diff suppressed because it is too large
Load Diff
-976
@@ -1,976 +0,0 @@
|
||||
dnl $Id$
|
||||
|
||||
dnl Process this file with autoconf to produce a configure script.
|
||||
dnl
|
||||
dnl usage : aclocal -I config/ && autoconf && ./configure && make
|
||||
|
||||
dnl then : VAR=VAL ./configure
|
||||
|
||||
dnl In some configurations (AIX) the next line is needed:
|
||||
dnl MPIFC=mpxlf95 ./configure
|
||||
|
||||
dnl then : ./configure VAR=VAL
|
||||
dnl then : ./configure --help=short
|
||||
dnl then : ./configure --help
|
||||
|
||||
dnl the PSBLAS modules get this task difficult to accomplish!
|
||||
dnl SEE : --module-path --include-path
|
||||
|
||||
dnl NOTE : There is no cross compilation support.
|
||||
|
||||
dnl NOTE : missing ifort and kl* library handling..
|
||||
dnl NOTE : odd configurations like ifc + gcc still await in the mist of the unknown
|
||||
|
||||
|
||||
###############################################################################
|
||||
###############################################################################
|
||||
#
|
||||
# This script is used by the PSBLAS to determine the compilers, linkers, and
|
||||
# libraries to build its libraries executable code.
|
||||
# Its behaviour is driven on the compiler it finds or it is dictated to work
|
||||
# with.
|
||||
#
|
||||
###############################################################################
|
||||
###############################################################################
|
||||
|
||||
# NOTE: the literal for version (the second argument to AC_INIT should be a literal!)
|
||||
AC_INIT([AMG4PSBLAS],1.1.0, [https://github.com/sfilippone/amg4psblas/issues])
|
||||
|
||||
# VERSION is the file containing the PSBLAS version code
|
||||
# FIXME
|
||||
amg4psblas_cv_version="1.1.0"
|
||||
|
||||
# A sample source file
|
||||
AC_CONFIG_SRCDIR([amgprec/amg_prec_type.f90])
|
||||
# Our custom M4 macros are in the 'config' directory
|
||||
AC_CONFIG_MACRO_DIR([config])
|
||||
AC_MSG_NOTICE([
|
||||
--------------------------------------------------------------------------------
|
||||
Welcome to the $PACKAGE_NAME $amg4psblas_cv_version configure Script.
|
||||
|
||||
This creates Make.inc, but if you read carefully the
|
||||
documentation, you can make your own by hand for your needs.
|
||||
|
||||
./configure --with-psblas=/path/to/psblas
|
||||
See ./configure --help=short fore more info.
|
||||
--------------------------------------------------------------------------------
|
||||
])
|
||||
|
||||
###############################################################################
|
||||
# FLAGS and LIBS user customization
|
||||
###############################################################################
|
||||
|
||||
dnl NOTE : no spaces before the comma, and no brackets before the second argument!
|
||||
PAC_ARG_WITH_PSBLAS
|
||||
PSBLAS_DIR="$pac_cv_psblas_dir";
|
||||
PSBLAS_INCDIR="$pac_cv_psblas_incdir";
|
||||
PSBLAS_MODDIR="$pac_cv_psblas_moddir";
|
||||
PSBLAS_LIBDIR="$pac_cv_psblas_libdir";
|
||||
AC_MSG_CHECKING([for PSBLAS install dir])
|
||||
if test "X$PSBLAS_DIR" != "X" ; then
|
||||
case $PSBLAS_DIR in
|
||||
/*) ;;
|
||||
*) AC_MSG_ERROR([The PSBLAS installation dir must be an absolute pathname
|
||||
specified with --with-psblas=/path/to/psblas])
|
||||
esac
|
||||
if test ! -d "$PSBLAS_DIR" ; then
|
||||
AC_MSG_ERROR([Could not find PSBLAS build dir $PSBLAS_DIR!])
|
||||
fi
|
||||
AC_MSG_RESULT([$PSBLAS_DIR])
|
||||
fi
|
||||
|
||||
AM_INIT_AUTOMAKE
|
||||
dnl Specify required version of autoconf.
|
||||
AC_PREREQ(2.59)
|
||||
#
|
||||
# Installation.
|
||||
#
|
||||
#
|
||||
AC_PROG_INSTALL
|
||||
|
||||
AC_MSG_CHECKING([where to install])
|
||||
case $prefix in
|
||||
\/* ) eval "INSTALL_DIR=$prefix";;
|
||||
* ) eval "INSTALL_DIR=/usr/local/amg4psblas";;
|
||||
esac
|
||||
case $libdir in
|
||||
\/* ) eval "INSTALL_LIBDIR=$libdir";;
|
||||
* ) eval "INSTALL_LIBDIR=$INSTALL_DIR/lib";;
|
||||
esac
|
||||
case $includedir in
|
||||
\/* ) eval "INSTALL_INCLUDEDIR=$includedir";;
|
||||
* ) eval "INSTALL_INCLUDEDIR=$INSTALL_DIR/include";;
|
||||
esac
|
||||
INSTALL_MODULESDIR=$INSTALL_DIR/modules
|
||||
case $docsdir in
|
||||
\/* ) eval "INSTALL_DOCSDIR=$docsdir";;
|
||||
* ) eval "INSTALL_DOCSDIR=$INSTALL_DIR/docs";;
|
||||
esac
|
||||
case $samplesdir in
|
||||
\/* ) eval "INSTALL_SAMPLESDIR=$samplesdir";;
|
||||
* ) eval "INSTALL_SAMPLESDIR=$INSTALL_DIR/samples";;
|
||||
esac
|
||||
AC_MSG_RESULT([$INSTALL_DIR $INSTALL_INCLUDEDIR $INSTALL_MODULESDIR $INSTALL_LIBDIR $INSTALL_DOCSDIR $INSTALL_SAMPLESDIR])
|
||||
|
||||
dnl
|
||||
dnl We set our own FC flags, ignore those from AC_PROG_FC but not those from the
|
||||
dnl environment variable. Same for C
|
||||
dnl
|
||||
save_FCFLAGS="$FCFLAGS";
|
||||
AC_PROG_FC([ftn xlf2003_r xlf2003 xlf95_r xlf95 xlf90 xlf pgf95 pgf90 ifort ifc nagfor gfortran])
|
||||
FCFLAGS="$save_FCFLAGS";
|
||||
save_CFLAGS="$CFLAGS";
|
||||
AC_PROG_CC([cc xlc pgcc icc gcc ])
|
||||
CFLAGS="$save_CFLAGS";
|
||||
save_CXXFLAGS="$CXXFLAGS";
|
||||
AC_PROG_CXX([CC xlc++ icpc g++])
|
||||
CXXFLAGS="$save_CXXFLAGS";
|
||||
dnl AC_PROG_CXX
|
||||
|
||||
dnl AC_PROG_F90 doesn't exist, at the time of writing this !
|
||||
dnl AC_PROG_F90
|
||||
|
||||
# Sanity checks, although redundant (useful when debugging this configure.ac)!
|
||||
if test "X$FC" == "X" ; then
|
||||
AC_MSG_ERROR([Problem : No Fortran compiler specified nor found!])
|
||||
fi
|
||||
|
||||
if eval "$FC -qversion 2>&1 | grep XL 2>/dev/null" ; then
|
||||
# Some configurations of the XLF want "-WF," prepended to -D.. flags.
|
||||
# TODO : discover the exact conditions when the usage of -WF is needed.
|
||||
amg_cv_define_prepend="-WF,"
|
||||
if eval "$MPIFC -qversion 2>&1 | grep -e\"Version: 10\.\" 2>/dev/null"; then
|
||||
FDEFINES="$amg_cv_define_prepend-DXLF_10 $FDEFINES"
|
||||
fi
|
||||
|
||||
# Note : there could be problems with old xlf compiler versions ( <10.1 )
|
||||
# since (as far as it is known to us) -WF, is not used in earlier versions.
|
||||
# More problems could be undocumented yet.
|
||||
fi
|
||||
|
||||
if test "X$CC" == "X" ; then
|
||||
AC_MSG_ERROR([Problem : No C compiler specified nor found!])
|
||||
fi
|
||||
AC_PROG_CC_STDC()
|
||||
if test "x$ac_cv_prog_cc_stdc" == "xno" ; then
|
||||
AC_MSG_ERROR([Problem : Need a C99 compiler ! ])
|
||||
else
|
||||
C99OPT="$ac_cv_prog_cc_stdc";
|
||||
fi
|
||||
###############################################################################
|
||||
# Suitable MPI compilers detection
|
||||
###############################################################################
|
||||
# Note: Someday we will contemplate a fake MPI - configured version of PSBLAS
|
||||
###############################################################################
|
||||
# First check whether the user required our serial (fake) mpi.
|
||||
PAC_ARG_SERIAL_MPI
|
||||
|
||||
#Note : we miss the name of the Intel C compiler
|
||||
if test x"$pac_cv_serial_mpi" == x"yes" ; then
|
||||
FAKEMPI="fakempi.o";
|
||||
MPIFC="$FC";
|
||||
MPICC="$CC";
|
||||
MPICXX="$CXX";
|
||||
CXXDEFINES="-DSERIAL_MPI $CXXDEFINES";
|
||||
|
||||
else
|
||||
AC_LANG([C])
|
||||
if test "X$MPICC" = "X" ; then
|
||||
# This is our MPICC compiler preference: it will override ACX_MPI's first try.
|
||||
AC_CHECK_PROGS([MPICC],[mpxlc mpiicc mpcc mpicc cc])
|
||||
fi
|
||||
ACX_MPI([], [AC_MSG_ERROR([[Cannot find any suitable MPI implementation for C]])])
|
||||
|
||||
|
||||
AC_LANG([Fortran])
|
||||
|
||||
if test "X$MPIFC" = "X" ; then
|
||||
# This is our MPIFC compiler preference: it will override ACX_MPI's first try.
|
||||
AC_CHECK_PROGS([MPIFC],[mpxlf2003_r mpxlf2003 mpxlf95_r mpxlf90 mpiifort mpf95 mpf90 mpifort mpif95 mpif90 ftn ])
|
||||
fi
|
||||
|
||||
ACX_MPI([], [AC_MSG_ERROR([[Cannot find any suitable MPI implementation for Fortran]])])
|
||||
AC_LANG([C++])
|
||||
if test "X$MPICXX" = "X" ; then
|
||||
# This is our MPICC compiler preference: it will override ACX_MPI's first try.
|
||||
AC_CHECK_PROGS([MPICXX],[mpxlc++ mpiicpc mpicxx])
|
||||
fi
|
||||
ACX_MPI([], [AC_MSG_ERROR([[Cannot find any suitable MPI implementation for C++]])])
|
||||
AC_LANG([Fortran])
|
||||
|
||||
FC="$MPIFC" ;
|
||||
CC="$MPICC";
|
||||
CXX="$MPICXX";
|
||||
fi
|
||||
|
||||
AC_LANG([C])
|
||||
|
||||
dnl Now on, MPIFC should be set, and MPICC
|
||||
|
||||
###############################################################################
|
||||
# Sanity checks, although redundant (useful when debugging this configure.ac)!
|
||||
###############################################################################
|
||||
|
||||
if test "X$MPIFC" == "X" ; then
|
||||
AC_MSG_ERROR([Problem : No MPI Fortran compiler specified nor found!])
|
||||
fi
|
||||
|
||||
if test "X$MPICC" == "X" ; then
|
||||
AC_MSG_ERROR([Problem : No MPI C compiler specified nor found!])
|
||||
fi
|
||||
|
||||
###############################################################################
|
||||
# FLAGS and LIBS user customization
|
||||
###############################################################################
|
||||
|
||||
dnl NOTE : no spaces before the comma, and no brackets before the second argument!
|
||||
PAC_ARG_WITH_FLAGS(ccopt,CCOPT)
|
||||
PAC_ARG_WITH_FLAGS(cxxopt,CXXOPT)
|
||||
PAC_ARG_WITH_FLAGS(fcopt,FCOPT)
|
||||
PAC_ARG_WITH_LIBS
|
||||
PAC_ARG_WITH_FLAGS(clibs,CLIBS)
|
||||
PAC_ARG_WITH_FLAGS(flibs,FLIBS)
|
||||
PAC_ARG_WITH_FLAGS(cxxlibs,CXXLIBS)
|
||||
|
||||
dnl candidates for removal:
|
||||
PAC_ARG_WITH_FLAGS(library-path,LIBRARYPATH)
|
||||
PAC_ARG_WITH_FLAGS(include-path,INCLUDEPATH)
|
||||
PAC_ARG_WITH_FLAGS(module-path,MODULE_PATH)
|
||||
|
||||
# we just gave the user the chance to append values to these variables
|
||||
PAC_ARG_WITH_EXTRA_LIBS
|
||||
|
||||
###############################################################################
|
||||
# Sanity checks, although redundant (useful when debugging this configure.ac)!
|
||||
###############################################################################
|
||||
|
||||
###############################################################################
|
||||
# Compiler identification (sadly, it is necessary)
|
||||
###############################################################################
|
||||
psblas_cv_fc=""
|
||||
|
||||
dnl Do we use gfortran & co ? Compiler identification.
|
||||
dnl NOTE : in /autoconf/autoconf/fortran.m4 there are plenty of better tests!
|
||||
|
||||
PAC_CHECK_HAVE_GFORTRAN(
|
||||
[psblas_cv_fc="gcc"],
|
||||
)
|
||||
|
||||
PAC_CHECK_HAVE_CRAYFTN(
|
||||
[psblas_cv_fc="cray"],
|
||||
)
|
||||
|
||||
if test x"$psblas_cv_fc" == "x" ; then
|
||||
if eval "$MPIFC -qversion 2>&1 | grep XL 2>/dev/null" ; then
|
||||
psblas_cv_fc="xlf"
|
||||
# Some configurations of the XLF want "-WF," prepended to -D.. flags.
|
||||
# TODO : discover the exact conditions when the usage of -WF is needed.
|
||||
psblas_cv_define_prepend="-WF,"
|
||||
if eval "$MPIFC -qversion 2>&1 | grep -e\"Version: 10\.\" 2>/dev/null"; then
|
||||
FDEFINES="$psblas_cv_define_prepend-DXLF_10 $FDEFINES"
|
||||
fi
|
||||
|
||||
# Note : there could be problems with old xlf compiler versions ( <10.1 )
|
||||
# since (as far as it is known to us) -WF, is not used in earlier versions.
|
||||
# More problems could be undocumented yet.
|
||||
elif eval "$MPIFC -V 2>&1 | grep Sun 2>/dev/null" ; then
|
||||
# Sun compiler detection
|
||||
|
||||
psblas_cv_fc="sun"
|
||||
elif eval "$MPIFC -V 2>&1 | grep Portland 2>/dev/null" ; then
|
||||
# Portland group compiler detection
|
||||
|
||||
psblas_cv_fc="pg"
|
||||
elif eval "$MPIFC -V 2>&1 | grep Intel.*Fortran.*Compiler 2>/dev/null" ; then
|
||||
# Intel compiler identification
|
||||
|
||||
psblas_cv_fc="ifc"
|
||||
elif eval "$MPIFC -v 2>&1 | grep NAG 2>/dev/null" ; then
|
||||
psblas_cv_fc="nag"
|
||||
FC="$MPIFC"
|
||||
else
|
||||
psblas_cv_fc=""
|
||||
# unsupported MPI Fortran compiler
|
||||
AC_MSG_NOTICE([[Unknown Fortran compiler, proceeding with fingers crossed !]])
|
||||
fi
|
||||
fi
|
||||
if test "X$psblas_cv_fc" == "Xgcc" ; then
|
||||
PAC_HAVE_MODERN_GFORTRAN(
|
||||
[],
|
||||
[AC_MSG_ERROR([Bailing out.])]
|
||||
)
|
||||
fi
|
||||
|
||||
|
||||
###############################################################################
|
||||
# Linking, symbol mangling, and misc tests
|
||||
###############################################################################
|
||||
|
||||
# Note : This is functional to Make.inc rules and structure (see below).
|
||||
AC_LANG([C])
|
||||
AC_CHECK_SIZEOF(void *)
|
||||
# Define for platforms with 64 bit (void * ) pointers
|
||||
if test X"$ac_cv_sizeof_void_p" == X"8" ; then
|
||||
CDEFINES="-DPtr64Bits $CDEFINES"
|
||||
fi
|
||||
AC_LANG([Fortran])
|
||||
__AC_FC_NAME_MANGLING
|
||||
if test "X$psblas_cv_fc" == X"pg" ; then
|
||||
FC=$save_FC
|
||||
fi
|
||||
AC_LANG([C])
|
||||
dnl AC_MSG_NOTICE([Fortran name mangling: $ac_cv_fc_mangling])
|
||||
[pac_fc_case=${ac_cv_fc_mangling%%,*}]
|
||||
[pac_fc_under=${ac_cv_fc_mangling#*,}]
|
||||
[pac_fc_sec_under=${pac_fc_under#*,}]
|
||||
[pac_fc_sec_under=${pac_fc_sec_under# }]
|
||||
[pac_fc_under=${pac_fc_under%%,*}]
|
||||
[pac_fc_under=${pac_fc_under# }]
|
||||
AC_MSG_CHECKING([defines for C/Fortran name interfaces])
|
||||
if test "x$pac_fc_case" == "xlower case"; then
|
||||
if test "x$pac_fc_under" == "xunderscore"; then
|
||||
if test "x$pac_fc_sec_under" == "xno extra underscore"; then
|
||||
pac_f_c_names="-DLowerUnderscore"
|
||||
elif test "x$pac_fc_sec_under" == "xextra underscore"; then
|
||||
pac_f_c_names="-DLowerDoubleUnderscore"
|
||||
else
|
||||
pac_f_c_names="-DUNKNOWN"
|
||||
dnl AC_MSG_NOTICE([Fortran name mangling extra underscore unknown case])
|
||||
fi
|
||||
elif test "x$pac_fc_under" == "xno underscore"; then
|
||||
pac_f_c_names="-DLowerCase"
|
||||
else
|
||||
pac_f_c_names="-DUNKNOWN"
|
||||
dnl AC_MSG_NOTICE([Fortran name mangling underscore unknown case])
|
||||
fi
|
||||
elif test "x$pac_fc_case" == "xupper case"; then
|
||||
if test "x$pac_fc_under" == "xunderscore"; then
|
||||
if test "x$pac_fc_sec_under" == "xno extra underscore"; then
|
||||
pac_f_c_names="-DUpperUnderscore"
|
||||
elif test "x$pac_fc_sec_under" == "xextra underscore"; then
|
||||
pac_f_c_names="-DUpperDoubleUnderscore"
|
||||
else
|
||||
pac_f_c_names="-DUNKNOWN"
|
||||
dnl AC_MSG_NOTICE([Fortran name mangling extra underscore unknown case])
|
||||
fi
|
||||
elif test "x$pac_fc_under" == "xno underscore"; then
|
||||
pac_f_c_names="-DUpperCase"
|
||||
else
|
||||
pac_f_c_names="-DUNKNOWN"
|
||||
dnl AC_MSG_NOTICE([Fortran name mangling underscore unknown case])
|
||||
fi
|
||||
dnl AC_MSG_NOTICE([Fortran name mangling UPPERCASE not handled])
|
||||
else
|
||||
pac_f_c_names="-DUNKNOWN"
|
||||
dnl AC_MSG_NOTICE([Fortran name mangling unknown case])
|
||||
fi
|
||||
CDEFINES="$pac_f_c_names $CDEFINES"
|
||||
|
||||
AC_MSG_RESULT([ $pac_f_c_names ])
|
||||
|
||||
###############################################################################
|
||||
# Make.inc generation logic
|
||||
###############################################################################
|
||||
# Honor CFLAGS if they were specified explicitly, but --with-ccopt take precedence
|
||||
if test "X$CCOPT" == "X" ; then
|
||||
CCOPT="$CFLAGS";
|
||||
fi
|
||||
if test "X$CCOPT" == "X" ; then
|
||||
if test "X$psblas_cv_fc" == "Xgcc" ; then
|
||||
# note that no space should be placed around the equality symbol in assignements
|
||||
# Note : 'native' is valid _only_ on GCC/x86 (32/64 bits)
|
||||
CCOPT="-O3 $CCOPT"
|
||||
|
||||
elif test "X$psblas_cv_fc" == X"xlf" ; then
|
||||
# XL compiler : consider using -qarch=auto
|
||||
CCOPT="-O3 -qarch=auto $CCOPT"
|
||||
elif test "X$psblas_cv_fc" == X"ifc" ; then
|
||||
# other compilers ..
|
||||
CCOPT="-O3 $CCOPT"
|
||||
elif test "X$psblas_cv_fc" == X"pg" ; then
|
||||
# other compilers ..
|
||||
CCOPT="-fast $CCOPT"
|
||||
# NOTE : PG & Sun use -fast instead -O3
|
||||
elif test "X$psblas_cv_fc" == X"sun" ; then
|
||||
# other compilers ..
|
||||
CCOPT="-fast $CCOPT"
|
||||
elif test "X$psblas_cv_fc" == X"cray" ; then
|
||||
CCOPT="-O3 $CCOPT"
|
||||
MPICC="cc"
|
||||
elif test "X$psblas_cv_fc" == X"nag" ; then
|
||||
# using GCC in conjunction with NAG.
|
||||
CCOPT="-O2"
|
||||
else
|
||||
CCOPT="-O2 $CCOPT"
|
||||
fi
|
||||
fi
|
||||
#CFLAGS="${CCOPT}"
|
||||
if test "X$CXXOPT" == "X" ; then
|
||||
CXXOPT="$CXXFLAGS";
|
||||
fi
|
||||
if test "X$CXXOPT" == "X" ; then
|
||||
if test "X$psblas_cv_fc" == "Xgcc" ; then
|
||||
# note that no space should be placed around the equality symbol in assignements
|
||||
# Note : 'native' is valid _only_ on GCC/x86 (32/64 bits)
|
||||
CXXOPT="-g -O3 $CXXOPT"
|
||||
|
||||
elif test "X$psblas_cv_fc" == X"xlf" ; then
|
||||
# XL compiler : consider using -qarch=auto
|
||||
CXXOPT="-O3 -qarch=auto $CXXOPT"
|
||||
elif test "X$psblas_cv_fc" == X"ifc" ; then
|
||||
# other compilers ..
|
||||
CXXOPT="-O3 $CXXOPT"
|
||||
elif test "X$psblas_cv_fc" == X"pg" ; then
|
||||
# other compilers ..
|
||||
CXXCOPT="-fast $CXXOPT"
|
||||
# NOTE : PG & Sun use -fast instead -O3
|
||||
elif test "X$psblas_cv_fc" == X"sun" ; then
|
||||
# other compilers ..
|
||||
CXXOPT="-fast $CXXOPT"
|
||||
elif test "X$psblas_cv_fc" == X"cray" ; then
|
||||
CXXOPT="-O3 $CXXOPT"
|
||||
MPICXX="CC"
|
||||
else
|
||||
CXXOPT="-g -O3 $CXXOPT"
|
||||
fi
|
||||
fi
|
||||
|
||||
|
||||
# Honor FCFLAGS if they were specified explicitly, but --with-fcopt take precedence
|
||||
if test "X$FCOPT" == "X" ; then
|
||||
FCOPT="$FCFLAGS";
|
||||
fi
|
||||
if test "X$FCOPT" == "X" ; then
|
||||
if test "X$psblas_cv_fc" == "Xgcc" ; then
|
||||
# note that no space should be placed around the equality symbol in assignations
|
||||
# Note : 'native' is valid _only_ on GCC/x86 (32/64 bits)
|
||||
FCOPT="-O3 $FCOPT"
|
||||
elif test "X$psblas_cv_fc" == X"xlf" ; then
|
||||
# XL compiler : consider using -qarch=auto
|
||||
FCOPT="-O3 -qarch=auto -qlanglvl=extended -qxlf2003=polymorphic:autorealloc $FCOPT"
|
||||
FCFLAGS="-qhalt=e -qlanglvl=extended -qxlf2003=polymorphic:autorealloc $FCFLAGS"
|
||||
elif test "X$psblas_cv_fc" == X"ifc" ; then
|
||||
# other compilers ..
|
||||
FCOPT="-O3 $FCOPT"
|
||||
elif test "X$psblas_cv_fc" == X"pg" ; then
|
||||
# other compilers ..
|
||||
FCOPT="-fast $FCOPT"
|
||||
# NOTE : PG & Sun use -fast instead -O3
|
||||
elif test "X$psblas_cv_fc" == X"sun" ; then
|
||||
# other compilers ..
|
||||
FCOPT="-fast $FCOPT"
|
||||
elif test "X$psblas_cv_fc" == X"cray" ; then
|
||||
FCOPT="-O3 -em $FCOPT"
|
||||
elif test "X$psblas_cv_fc" == X"nag" ; then
|
||||
# NAG compiler ..
|
||||
FCOPT="-O2 "
|
||||
# NOTE : PG & Sun use -fast instead -O3
|
||||
else
|
||||
FCOPT="-O2 $FCOPT"
|
||||
fi
|
||||
fi
|
||||
if test "X$psblas_cv_fc" == X"nag" ; then
|
||||
# Add needed options
|
||||
FCOPT="$FCOPT -dcfuns -f2003 -wmismatch=mpi_scatterv,mpi_alltoallv,mpi_gatherv,mpi_allgatherv"
|
||||
EXTRA_OPT="-mismatch_all"
|
||||
fi
|
||||
|
||||
|
||||
# COPT,FCOPT are aliases for CFLAGS,FCFLAGS .
|
||||
|
||||
##############################################################################
|
||||
# Compilers variables selection
|
||||
##############################################################################
|
||||
FC=${FC}
|
||||
CC=${CC}
|
||||
CXX=${CXX}
|
||||
CCOPT="$CCOPT $C99OPT"
|
||||
|
||||
|
||||
##############################################################################
|
||||
# Choice of our compilers, needed by Make.inc
|
||||
##############################################################################
|
||||
if test "X$psblas_cv_fc" == X"cray"
|
||||
then
|
||||
MODEXT=".mod"
|
||||
FMFLAG="-I"
|
||||
FIFLAG="-I"
|
||||
BASEMODNAME=PSB_BASE_MOD
|
||||
PRECMODNAME=PSB_PREC_MOD
|
||||
METHDMODNAME=PSB_KRYLOV_MOD
|
||||
UTILMODNAME=PSB_UTIL_MOD
|
||||
|
||||
else
|
||||
AX_F90_MODULE_EXTENSION
|
||||
AX_F90_MODULE_FLAG
|
||||
MODEXT=".$ax_cv_f90_modext"
|
||||
FMFLAG="${ax_cv_f90_modflag%%[ ]*}"
|
||||
FIFLAG=-I
|
||||
BASEMODNAME=psb_base_mod
|
||||
PRECMODNAME=psb_prec_mod
|
||||
METHDMODNAME=psb_krylov_mod
|
||||
UTILMODNAME=psb_util_mod
|
||||
fi
|
||||
|
||||
|
||||
##############################################################################
|
||||
# Choice of our compilers, needed by Make.inc
|
||||
##############################################################################
|
||||
if test "X$FLINK" == "X" ; then
|
||||
FLINK=${MPF90}
|
||||
fi
|
||||
# Custom test : do we have a module or include for MPI Fortran interface?
|
||||
if test x"$pac_cv_serial_mpi" == x"yes" ; then
|
||||
FDEFINES="$psblas_cv_define_prepend-DSERIAL_MPI $psblas_cv_define_prepend-DMPI_MOD $FDEFINES";
|
||||
else
|
||||
PAC_FORTRAN_CHECK_HAVE_MPI_MOD_F08()
|
||||
if test x"$pac_cv_mpi_f08" == x"yes" ; then
|
||||
dnl FDEFINES="$psblas_cv_define_prepend-DMPI_MOD_F08 $FDEFINES";
|
||||
FDEFINES="$psblas_cv_define_prepend-DMPI_MOD $FDEFINES";
|
||||
else
|
||||
PAC_FORTRAN_CHECK_HAVE_MPI_MOD(
|
||||
[FDEFINES="$psblas_cv_define_prepend-DMPI_MOD $FDEFINES"],
|
||||
[FDEFINES="$psblas_cv_define_prepend-DMPI_H $FDEFINES"])
|
||||
fi
|
||||
fi
|
||||
|
||||
FLINK="$MPIFC"
|
||||
PAC_ARG_OPENMP()
|
||||
if test x"$pac_cv_openmp" == x"yes" ; then
|
||||
FDEFINES="$psblas_cv_define_prepend-DOPENMP $FDEFINES";
|
||||
CDEFINES="-DOPENMP $CDEFINES";
|
||||
FCOPT="$FCOPT $pac_cv_openmp_fcopt";
|
||||
CCOPT="$CCOPT $pac_cv_openmp_ccopt";
|
||||
FLINK="$FLINK $pac_cv_openmp_fcopt";
|
||||
fi
|
||||
|
||||
PAC_FORTRAN_HAVE_PSBLAS([AC_MSG_RESULT([yes.])],
|
||||
[AC_MSG_ERROR([no. Could not find working version of PSBLAS.])])
|
||||
|
||||
PAC_FORTRAN_PSBLAS_VERSION()
|
||||
|
||||
if test "x$pac_cv_psblas_major" == "xunknown"; then
|
||||
AC_MSG_ERROR([PSBLAS version major "$pac_cv_psblas_major".])
|
||||
fi
|
||||
if test "x$pac_cv_psblas_minor" == "xunknown"; then
|
||||
AC_MSG_ERROR([PSBLAS version minor "$pac_cv_psblas_minor".])
|
||||
fi
|
||||
if test "x$pac_cv_psblas_patchlevel" == "xunknown"; then
|
||||
AC_MSG_ERROR([PSBLAS patchlevel "$pac_cv_psblas_patchlevel".])
|
||||
fi
|
||||
if (( $pac_cv_psblas_major < 3 )) ||
|
||||
( (( $pac_cv_psblas_major == 3 )) && (( $pac_cv_psblas_minor < 8 ))) ; then
|
||||
AC_MSG_ERROR([I need at least PSBLAS version 3.8.0])
|
||||
else
|
||||
AC_MSG_NOTICE([Am configuring with PSBLAS version $pac_cv_psblas_major.$pac_cv_psblas_minor.$pac_cv_psblas_patchlevel.])
|
||||
fi
|
||||
PAC_FORTRAN_PSBLAS_INTEGER_SIZES()
|
||||
AC_MSG_NOTICE([PSBLAS size of LPK "$pac_cv_psblas_lpk".])
|
||||
if test x"$pac_cv_psblas_lpk" == x8"" ; then
|
||||
CXXDEFINES="-DBIT64 $CXXDEFINES";
|
||||
fi
|
||||
|
||||
###############################################################################
|
||||
# Parachute rules for ar and ranlib ... (could cause problems)
|
||||
###############################################################################
|
||||
|
||||
if test "X$AR" == "X" ; then
|
||||
AR="ar"
|
||||
fi
|
||||
|
||||
if test "X$RANLIB" == "X" ; then
|
||||
RANLIB="ranlib"
|
||||
fi
|
||||
|
||||
# This should be portable
|
||||
AR="${AR} -cur"
|
||||
|
||||
|
||||
###############################################################################
|
||||
# NOTE :
|
||||
# Missing stuff :
|
||||
# In the case the detected fortran compiler is ifort, icc or gcc
|
||||
# should be valid options.
|
||||
# The same for pg (Portland Group compilers).
|
||||
###############################################################################
|
||||
|
||||
#
|
||||
# Tests for support of various Fortran features; some of them are critical,
|
||||
# some optional
|
||||
#
|
||||
|
||||
#
|
||||
# Critical features
|
||||
#
|
||||
|
||||
PAC_FORTRAN_TEST_EXTENDS(
|
||||
[],
|
||||
[AC_MSG_ERROR([Sorry, cannot build PSBLAS without support for EXTENDS.
|
||||
Please get a Fortran compiler that supports it, e.g. GNU Fortran 4.8.])]
|
||||
)
|
||||
|
||||
PAC_FORTRAN_TEST_CLASS_TBP(
|
||||
[],
|
||||
[AC_MSG_ERROR([Sorry, cannot build PSBLAS without support for CLASS and type bound procedures.
|
||||
Please get a Fortran compiler that supports them, e.g. GNU Fortran 4.8.])]
|
||||
)
|
||||
|
||||
PAC_FORTRAN_TEST_SOURCE(
|
||||
[],
|
||||
[AC_MSG_ERROR([Sorry, cannot build PSBLAS without support for SOURCE= allocation.
|
||||
Please get a Fortran compiler that supports it, e.g. GNU Fortran 4.8.])]
|
||||
)
|
||||
|
||||
PAC_FORTRAN_HAVE_MOVE_ALLOC(
|
||||
[],
|
||||
[AC_MSG_ERROR([Sorry, cannot build PSBLAS without support for MOVE_ALLOC.
|
||||
Please get a Fortran compiler that supports it, e.g. GNU Fortran 4.8.])]
|
||||
)
|
||||
|
||||
PAC_FORTRAN_TEST_ISO_C_BIND(
|
||||
[],
|
||||
[AC_MSG_ERROR([Sorry, cannot build PSBLAS without support for ISO_C_BINDING.
|
||||
Please get a Fortran compiler that supports it, e.g. GNU Fortran 4.8.])]
|
||||
)
|
||||
|
||||
PAC_FORTRAN_TEST_SAME_TYPE(
|
||||
[],
|
||||
[AC_MSG_ERROR([Sorry, cannot build PSBLAS without support for SAME_TYPE_AS.
|
||||
Please get a Fortran compiler that supports it, e.g. GNU Fortran 4.8.])]
|
||||
)
|
||||
|
||||
PAC_FORTRAN_TEST_EXTENDS_TYPE(
|
||||
[],
|
||||
[AC_MSG_ERROR([Sorry, cannot build PSBLAS without support for EXTENDS_TYPE_OF.
|
||||
Please get a Fortran compiler that supports it, e.g. GNU Fortran 4.8.])]
|
||||
)
|
||||
|
||||
PAC_FORTRAN_TEST_MOLD(
|
||||
[],
|
||||
[AC_MSG_ERROR([Sorry, cannot build PSBLAS without support for MOLD= allocation.
|
||||
Please get a Fortran compiler that supports it, e.g. GNU Fortran 4.8.])]
|
||||
)
|
||||
|
||||
PAC_FORTRAN_TEST_VOLATILE(
|
||||
[],
|
||||
[AC_MSG_ERROR([Sorry, cannot build PSBLAS without support for VOLATILE])]
|
||||
)
|
||||
|
||||
PAC_FORTRAN_TEST_ISO_C_BIND(
|
||||
[],
|
||||
[AC_MSG_ERROR([Sorry, cannot build PSBLAS without support for ISO_C_BINDING.
|
||||
Please get a Fortran compiler that supports it, e.g. GNU Fortran 4.8.])]
|
||||
)
|
||||
|
||||
PAC_FORTRAN_TEST_ISO_FORTRAN_ENV(
|
||||
[],
|
||||
[AC_MSG_ERROR([Sorry, cannot build PSBLAS without support for ISO_FORTRAN_ENV])]
|
||||
)
|
||||
|
||||
PAC_FORTRAN_TEST_FINAL(
|
||||
[],
|
||||
[AC_MSG_ERROR([Sorry, cannot build PSBLAS without support for FINAL])]
|
||||
)
|
||||
|
||||
|
||||
#
|
||||
# Optional features
|
||||
#
|
||||
|
||||
|
||||
PAC_FORTRAN_TEST_GENERICS(
|
||||
[],
|
||||
[FDEFINES="$psblas_cv_define_prepend-DHAVE_BUGGY_GENERICS $FDEFINES"]
|
||||
)
|
||||
|
||||
PAC_FORTRAN_TEST_FLUSH(
|
||||
[FDEFINES="$psblas_cv_define_prepend-DHAVE_FLUSH_STMT $FDEFINES"],
|
||||
)
|
||||
|
||||
|
||||
###############################################################################
|
||||
# Additional pathname stuff (yes, it is redundant and confusing...)
|
||||
###############################################################################
|
||||
|
||||
# -I
|
||||
if test x"$INCLUDEPATH" != "x" ; then
|
||||
FINCLUDES="$FINCLUDES $INCLUDEPATH"
|
||||
CINCLUDES="$CINCLUDES $INCLUDEPATH"
|
||||
fi
|
||||
|
||||
# -L
|
||||
if test x"$LIBRARYPATH" != "x" ; then
|
||||
FINCLUDES="$FINCLUDES $LIBRARYPATH"
|
||||
fi
|
||||
|
||||
# -I
|
||||
if test x"$MODULE_PATH" != "x" ; then
|
||||
FINCLUDES="$FINCLUDES $MODULE_PATH"
|
||||
fi
|
||||
|
||||
|
||||
###############################################################################
|
||||
# BLAS library presence checks
|
||||
###############################################################################
|
||||
|
||||
# Note : The libmkl.a (Intel Math Kernel Library) library could be used, too.
|
||||
# It is sufficient to specify it as -lmkl in the CLIBS or FLIBS or LIBS
|
||||
# and specify its path adjusting -L/path in CFLAGS.
|
||||
|
||||
# Right now it is a matter of user's taste when linking custom applications.
|
||||
# But PSBLAS examples could take advantage of these libraries, too.
|
||||
AC_LANG([Fortran])
|
||||
###############################################################################
|
||||
# BLAS library presence checks
|
||||
###############################################################################
|
||||
|
||||
# Note : The libmkl.a (Intel Math Kernel Library) library could be used, too.
|
||||
# It is sufficient to specify it as -lmkl in the CLIBS or FLIBS or LIBS
|
||||
# and specify its path adjusting -L/path in CFLAGS.
|
||||
|
||||
# Right now it is a matter of user's taste when linking custom applications.
|
||||
# But PSBLAS examples could take advantage of these libraries, too.
|
||||
|
||||
PAC_BLAS([], [AC_MSG_ERROR([[Cannot find BLAS library, specify a path using --with-blas=DIR/LIB (for example --with-blas=/usr/path/lib/libcxml.a)]])])
|
||||
PAC_LAPACK(
|
||||
[FDEFINES="$psblas_cv_define_prepend-DHAVE_LAPACK $FDEFINES"],
|
||||
)
|
||||
AC_LANG([C])
|
||||
|
||||
|
||||
###############################################################################
|
||||
# BLACS library presence checks
|
||||
###############################################################################
|
||||
#AC_LANG([C])
|
||||
#if test x"$pac_cv_serial_mpi" == x"no" ; then
|
||||
#save_FC="$FC";
|
||||
#save_CC="$CC";
|
||||
#FC="$MPIFC";
|
||||
#CC="$MPICC";
|
||||
#PAC_CHECK_BLACS
|
||||
#FC="$save_FC";
|
||||
#CC="$save_CC";
|
||||
#fi
|
||||
|
||||
PAC_MAKE_IS_GNUMAKE
|
||||
###############################################################################
|
||||
# Auxiliary packages
|
||||
###############################################################################
|
||||
|
||||
PAC_CHECK_METIS
|
||||
|
||||
AC_MSG_CHECKING([Compatibility between metis and LPK])
|
||||
if test "x$pac_cv_lpk_size" == "x4" ; then
|
||||
if test "x$pac_cv_metis_idx" == "x64" ; then
|
||||
dnl mismatch between metis size and PSBLAS LPK
|
||||
psblas_cv_have_metis="no";
|
||||
dnl
|
||||
fi
|
||||
fi
|
||||
if test "x$pac_cv_lpk_size" == "x8" ; then
|
||||
if test "x$pac_cv_metis_idx" == "x32" ; then
|
||||
dnl mismatch between metis size and PSBLAS LPK
|
||||
psblas_cv_have_metis="no";
|
||||
fi
|
||||
fi
|
||||
AC_MSG_RESULT([$psblas_cv_have_metis])
|
||||
|
||||
if test "x$pac_cv_metis_idx" == "xunknown" ; then
|
||||
dnl mismatch between metis size and PSBLAS LPK
|
||||
AC_MSG_NOTICE([Unknown METIS bitsize.])
|
||||
$psblas_cv_have_metis = "no";
|
||||
fi
|
||||
if test "x$pac_cv_metis_real" == "xunknown" ; then
|
||||
dnl mismatch between metis size and PSBLAS LPK
|
||||
AC_MSG_NOTICE([Unknown METIS REAL bitsize.])
|
||||
$psblas_cv_have_metis = "no";
|
||||
fi
|
||||
if test "x$psblas_cv_have_metis" == "xyes" ; then
|
||||
FDEFINES="$psblas_cv_define_prepend-DHAVE_METIS $psblas_cv_define_prepend-DMETIS_$pac_cv_metis_idx $psblas_cv_define_prepend-DMETIS_REAL_$pac_cv_metis_real $FDEFINES"
|
||||
CDEFINES="-DHAVE_METIS_ $psblas_cv_metis_includes $CDEFINES -DMETIS_$pac_cv_metis_idx -DMETIS_REAL_$pac_cv_metis_real"
|
||||
METISINCFILE=$psblas_cv_metisincfile
|
||||
fi
|
||||
|
||||
|
||||
PAC_CHECK_MUMPS
|
||||
#
|
||||
# 1. Enable even with LPK=8, internally it will check if
|
||||
# the problem size fits into 4 bytes, very likely since we
|
||||
# are mostly using MUMPS at coarse level.
|
||||
#
|
||||
dnl if test "x$amg4psblas_cv_have_mumps" == "xyes" ; then
|
||||
dnl if test "x$pac_cv_psblas_ipk" == "x8" ; then
|
||||
dnl AC_MSG_NOTICE([PSBLAS defines PSB_IPK_ as $pac_cv_psblas_ipk. MUMPS interfacing disabled. ])
|
||||
dnl MUMPS_FLAGS="";
|
||||
dnl MUMPS_LIBS="";
|
||||
dnl amg4psblas_cv_have_mumps=no;
|
||||
dnl fi
|
||||
dnl fi
|
||||
if test "x$amg4psblas_cv_have_mumps" == "xyes" ; then
|
||||
if test "x$pac_cv_psblas_lpk" == "x8" ; then
|
||||
AC_MSG_NOTICE([PSBLAS defines PSB_LPK_ as $pac_cv_psblas_lpk. MUMPS interfacing will fail when called in global mode on very large matrices. ])
|
||||
fi
|
||||
if test "x$pac_mumps_fmods_ok" == "xyes" ; then
|
||||
FDEFINES="$amg_cv_define_prepend-DHAVE_MUMPS_ $amg_cv_define_prepend-DHAVE_MUMPS_MODULES_ $MUMPS_MODULES $FDEFINES"
|
||||
MUMPS_FLAGS="-DHave_MUMPS_ $MUMPS_MODULES"
|
||||
elif test "x$pac_mumps_fincs_ok" == "xyes" ; then
|
||||
FDEFINES="$amg_cv_define_prepend-DHAVE_MUMPS_ $amg_cv_define_prepend-DHAVE_MUMPS_INCLUDES_ $MUMPS_FINCLUDES $FDEFINES"
|
||||
MUMPS_FLAGS="-DHave_MUMPS_ $MUMPS_INCLUDES"
|
||||
else
|
||||
# This should not happen
|
||||
MUMPS_FLAGS=""
|
||||
MUMPS_LIBS=""
|
||||
fi
|
||||
else
|
||||
MUMPS_FLAGS=""
|
||||
MUMPS_LIBS=""
|
||||
fi
|
||||
|
||||
PAC_CHECK_UMFPACK
|
||||
if test "x$amg4psblas_cv_have_umfpack" == "xyes" ; then
|
||||
UMF_FLAGS="-DHave_UMF_ $UMF_INCLUDES"
|
||||
FDEFINES="$amg_cv_define_prepend-DHAVE_UMF_ $FDEFINES"
|
||||
else
|
||||
UMF_FLAGS=""
|
||||
fi
|
||||
|
||||
PAC_CHECK_SUPERLU
|
||||
if test "x$amg4psblas_cv_have_superlu" == "xyes" ; then
|
||||
SLU_FLAGS="-DHave_SLU_ -DSLU_VERSION_$pac_slu_version $SLU_INCLUDES"
|
||||
FDEFINES="$amg_cv_define_prepend-DHAVE_SLU_ $FDEFINES"
|
||||
else
|
||||
SLU_FLAGS=""
|
||||
fi
|
||||
|
||||
PAC_CHECK_SUPERLUDIST()
|
||||
|
||||
if test "x$amg4psblas_cv_have_superludist" == "xyes" ; then
|
||||
pac_sludist_version="$amg4psblas_cv_superludist_major$amg4psblas_cv_superludist_minor";
|
||||
AC_MSG_NOTICE([Configuring with SuperLU_DIST version flag $pac_sludist_version])
|
||||
SLUDIST_FLAGS=""
|
||||
SLUDIST_FLAGS="-DHave_SLUDist_ -DSLUD_VERSION_="$pac_sludist_version" $SLUDIST_INCLUDES"
|
||||
FDEFINES="$amg_cv_define_prepend-DHAVE_SLUDIST_ $FDEFINES"
|
||||
else
|
||||
SLUDIST_FLAGS=""
|
||||
fi
|
||||
|
||||
##############################################
|
||||
FINCLUDES="$PSBLAS_INCLUDES"
|
||||
|
||||
AMGFDEFINES="$FDEFINES"
|
||||
AMGCDEFINES="$CDEFINES"
|
||||
AMGCXXDEFINES="$CXXDEFINES"
|
||||
|
||||
LIBDIR=lib
|
||||
BASELIBNAME=libpsb_base.a
|
||||
PRECLIBNAME=libpsb_prec.a
|
||||
METHDLIBNAME=libpsb_krylov.a
|
||||
UTILLIBNAME=libpsb_util.a
|
||||
AMGLIBNAME=libamg_prec.a
|
||||
|
||||
COMPILERULES='
|
||||
PSBLDLIBS=$(LAPACK) $(BLAS) $(METIS_LIB) $(AMD_LIB) $(LIBS)
|
||||
CXXDEFINES=$(PSBCXXDEFINES)
|
||||
CDEFINES=$(PSBCDEFINES)
|
||||
FDEFINES=$(PSBFDEFINES)
|
||||
|
||||
|
||||
# These should be portable rules, arent they?
|
||||
.c.o:
|
||||
$(CC) $(CCOPT) $(CINCLUDES) $(CDEFINES) -c $< -o $@
|
||||
.f90.o:
|
||||
$(FC) $(FCOPT) $(FINCLUDES) -c $< -o $@
|
||||
.F90.o:
|
||||
$(FC) $(FCOPT) $(FINCLUDES) $(FDEFINES) -c $< -o $@
|
||||
.cpp.o:
|
||||
$(CXX) $(CXXOPT) $(CXXINCLUDES) $(CXXDEFINES) -c $< -o $@'
|
||||
###############################################################################
|
||||
# Variable substitutions : the Make.inc.in will have these @VARIABLES@
|
||||
# substituted.
|
||||
|
||||
AC_SUBST(PSBLAS_DIR)
|
||||
AC_SUBST(PSBLAS_INCDIR)
|
||||
AC_SUBST(PSBLAS_MODDIR)
|
||||
AC_SUBST(PSBLAS_LIBDIR)
|
||||
AC_SUBST(PSBLAS_INCLUDES)
|
||||
dnl AC_SUBST(PSBLAS_INSTALL_MAKEINC)
|
||||
AC_SUBST(PSBLAS_LIBS)
|
||||
AC_SUBST(PSBLAS_RULES)
|
||||
|
||||
AC_SUBST(INSTALL)
|
||||
AC_SUBST(INSTALL_DATA)
|
||||
AC_SUBST(INSTALL_DIR)
|
||||
AC_SUBST(INSTALL_LIBDIR)
|
||||
AC_SUBST(INSTALL_INCLUDEDIR)
|
||||
AC_SUBST(INSTALL_MODULESDIR)
|
||||
AC_SUBST(INSTALL_DOCSDIR)
|
||||
AC_SUBST(INSTALL_SAMPLESDIR)
|
||||
|
||||
AC_SUBST(EXTRA_LIBS)
|
||||
AC_SUBST(BLAS_LIBS)
|
||||
AC_SUBST(LAPACK_LIBS)
|
||||
AC_SUBST(METIS_LIBS)
|
||||
AC_SUBST(MUMPS_FLAGS)
|
||||
AC_SUBST(MUMPS_LIBS)
|
||||
AC_SUBST(SLU_FLAGS)
|
||||
AC_SUBST(SLU_LIBS)
|
||||
AC_SUBST(UMF_FLAGS)
|
||||
AC_SUBST(UMF_LIBS)
|
||||
AC_SUBST(SLUDIST_FLAGS)
|
||||
AC_SUBST(SLUDIST_LIBS)
|
||||
AC_SUBST(AMGFDEFINES)
|
||||
AC_SUBST(AMGCDEFINES)
|
||||
AC_SUBST(AMGCXXDEFINES)
|
||||
AC_SUBST(MODEXT)
|
||||
AC_SUBST(COMPILERULES)
|
||||
AC_SUBST(FDEFINES)
|
||||
AC_SUBST(CDEFINES)
|
||||
AC_SUBST(BASEMODNAME)
|
||||
AC_SUBST(PRECMODNAME)
|
||||
AC_SUBST(METHDMODNAME)
|
||||
AC_SUBST(UTILMODNAME)
|
||||
AC_SUBST(AMGLIBNAME)
|
||||
AC_SUBST(MPIFC)
|
||||
AC_SUBST(MPICC)
|
||||
AC_SUBST(MPICXX)
|
||||
AC_SUBST(FCOPT)
|
||||
AC_SUBST(CCOPT)
|
||||
AC_SUBST(CXXOPT)
|
||||
AC_SUBST(EXTRA_OPT)
|
||||
AC_SUBST(FAKEMPI)
|
||||
AC_SUBST(FIFLAG)
|
||||
AC_SUBST(FMFLAG)
|
||||
AC_SUBST(MODEXT)
|
||||
AC_SUBST(FLINK)
|
||||
AC_SUBST(LIBS)
|
||||
AC_SUBST(AR)
|
||||
AC_SUBST(RANLIB)
|
||||
AC_SUBST(MPIFC)
|
||||
AC_SUBST(MPIFCC)
|
||||
|
||||
###############################################################################
|
||||
# the following files will be created by Automake
|
||||
|
||||
AC_CONFIG_FILES([Make_n.inc])
|
||||
AC_OUTPUT()
|
||||
|
||||
###############################################################################
|
||||
|
||||
dnl Please note that brackets around variable identifiers are absolutely needed for compatibility..
|
||||
AC_MSG_NOTICE([
|
||||
${PACKAGE_NAME} ${amg4psblas_cv_version} has been configured as follows:
|
||||
|
||||
PSBLAS library : ${PSBLAS_DIR}
|
||||
MUMPS detected : ${amg4psblas_cv_have_mumps}
|
||||
SuperLU detected : ${amg4psblas_cv_have_superlu}
|
||||
SuperLU_Dist detected : ${amg4psblas_cv_have_superludist}
|
||||
UMFPack detected : ${amg4psblas_cv_have_umfpack}
|
||||
|
||||
If you are satisfied, run 'make' to build ${PACKAGE_NAME} and its documentation; otherwise
|
||||
type ./configure --help=short for a complete list of configure options specific to ${PACKAGE_NAME}.
|
||||
dnl To install the program and its documentation, run 'make install' if you are root,
|
||||
dnl or run 'su -c "make install"' if you are not root.
|
||||
])
|
||||
|
||||
###############################################################################
|
||||
|
||||
Binary file not shown.
@@ -31,7 +31,7 @@ class="cmr-12">University of Rome Tor-Vergata and IAC-CNR</span><br
|
||||
class="newline" /> <span
|
||||
class="cmr-12">Software version: 1.2</span><br
|
||||
class="newline" /><span
|
||||
class="cmr-12">June 9th, 2025</span>
|
||||
class="cmr-12">December 23rd, 2025</span>
|
||||
|
||||
|
||||
|
||||
|
||||
@@ -31,7 +31,7 @@ class="cmr-12">University of Rome Tor-Vergata and IAC-CNR</span><br
|
||||
class="newline" /> <span
|
||||
class="cmr-12">Software version: 1.2</span><br
|
||||
class="newline" /><span
|
||||
class="cmr-12">June 9th, 2025</span>
|
||||
class="cmr-12">December 23rd, 2025</span>
|
||||
|
||||
|
||||
|
||||
|
||||
+18
-16
@@ -72,32 +72,34 @@ class="small-caps">n</span></span>
|
||||
class="cmcsc-10x-x-120">PSBLAS</span><span
|
||||
class="cmr-12">) is a package of parallel algebraic multilevel preconditioners included in the</span>
|
||||
<span
|
||||
class="cmr-12">PSCToolkit (Parallel Sparse Computation Toolkit) software framework. It is a progress</span>
|
||||
class="cmr-12">PSCToolkit (Parallel Sparse Computation Toolkit) software framework. It</span>
|
||||
<span
|
||||
class="cmr-12">of a software development project started in 2007, named MLD2P4, which originally</span>
|
||||
class="cmr-12">is an evolutiuon of a software development project started in 2007, named</span>
|
||||
<span
|
||||
class="cmr-12">implemented a multilevel version of some domain decomposition preconditioners of</span>
|
||||
class="cmr-12">MLD2P4, which originally implemented a multilevel version of some domain</span>
|
||||
<span
|
||||
class="cmr-12">additive-Schwarz type, and was based on a parallel decoupled version of the well known</span>
|
||||
class="cmr-12">decomposition preconditioners of additive-Schwarz type, and was based on a parallel</span>
|
||||
<span
|
||||
class="cmr-12">smoothed aggregation method to generate the multilevel hierarchy of coarser</span>
|
||||
class="cmr-12">decoupled version of the well known smoothed aggregation method to generate the</span>
|
||||
<span
|
||||
class="cmr-12">matrices. In the last years, within the context of the EU-H2020 EoCoE project</span>
|
||||
class="cmr-12">multilevel hierarchy of coarser matrices. In the last few years the package</span>
|
||||
<span
|
||||
class="cmr-12">(Energy Oriented Center of Excellence), the package was extended for including</span>
|
||||
class="cmr-12">was extended for including new algorithms and functionalities for the setup</span>
|
||||
<span
|
||||
class="cmr-12">new algorithms and functionalities for the setup and application new AMG</span>
|
||||
class="cmr-12">and application new AMG preconditioners with the final aims of improving</span>
|
||||
<span
|
||||
class="cmr-12">preconditioners with the final aims of improving efficiency and scalability when tens of</span>
|
||||
class="cmr-12">efficiency and scalability when tens of thousands cores are used, and of boosting</span>
|
||||
<span
|
||||
class="cmr-12">thousands cores are used, and of boosting reliability in dealing with general</span>
|
||||
class="cmr-12">reliability in dealing with general symmetric positive definite linear systems; these</span>
|
||||
<span
|
||||
class="cmr-12">symmetric positive definite linear systems. Due to the significant number</span>
|
||||
class="cmr-12">developments have been supported in the context of the EU-H2020 EoCoE</span>
|
||||
<span
|
||||
class="cmr-12">project (Energy Oriented Center of Excellence). Due to the significant number</span>
|
||||
<span
|
||||
class="cmr-12">of changes and the increase in scope, we decided to rename the package as</span>
|
||||
<span
|
||||
class="cmr-12">AMG4PSBLAS.</span>
|
||||
<!--l. 16--><p class="indent" > <span
|
||||
<!--l. 27--><p class="indent" > <span
|
||||
class="cmr-12">AMG4PSBLAS has been designed to provide scalable and easy-to-use</span>
|
||||
<span
|
||||
class="cmr-12">preconditioners in the context of the PSBLAS (Parallel Sparse Basic Linear Algebra</span>
|
||||
@@ -111,14 +113,14 @@ class="cmr-12">algebraic approach; therefore users level interfaces assume that
|
||||
class="cmr-12">and preconditioners are represented as PSBLAS distributed sparse matrices.</span>
|
||||
<span
|
||||
class="cmr-12">AMG4PSBLAS enables the user to easily specify different features of an algebraic</span>
|
||||
<span
|
||||
class="cmr-12">multilevel preconditioner, thus allowing to experiment with different preconditioners for</span>
|
||||
|
||||
|
||||
|
||||
<span
|
||||
class="cmr-12">multilevel preconditioner, thus allowing to experiment with different preconditioners for</span>
|
||||
<span
|
||||
class="cmr-12">the problem and parallel computers at hand.</span>
|
||||
<!--l. 27--><p class="indent" > <span
|
||||
<!--l. 39--><p class="indent" > <span
|
||||
class="cmr-12">The package employs object-oriented design techniques in Fortran</span><span
|
||||
class="cmr-12"> 2003, with</span>
|
||||
<span
|
||||
@@ -132,7 +134,7 @@ class="cmr-12">parallel implementation is based on a Single Program Multiple Dat
|
||||
class="cmr-12">paradigm; the inter-process communication is based on MPI and is managed mainly</span>
|
||||
<span
|
||||
class="cmr-12">through PSBLAS.</span>
|
||||
<!--l. 35--><p class="indent" > <span
|
||||
<!--l. 47--><p class="indent" > <span
|
||||
class="cmr-12">This guide provides a brief description of the functionalities and the user interface</span>
|
||||
<span
|
||||
class="cmr-12">of AMG4PSBLAS.</span>
|
||||
|
||||
+32
-34
@@ -100,18 +100,18 @@ src="userhtml0x.png" alt="Ax = b,
|
||||
id="x4-3001r1"></a></div>
|
||||
</td><td class="equation-label"><span
|
||||
class="cmr-12">(1)</span></td></tr></table>
|
||||
<!--l. 11--><p class="nopar" ><span
|
||||
<!--l. 13--><p class="nopar" ><span
|
||||
class="cmr-12">where </span><span
|
||||
class="cmmi-12">A </span><span
|
||||
class="cmr-12">is a square, real or complex, sparse symmetric positive definite (s.p.d)</span>
|
||||
<span
|
||||
class="cmr-12">matrix.</span>
|
||||
<!--l. 19--><p class="indent" > <span
|
||||
<!--l. 21--><p class="indent" > <span
|
||||
class="cmr-12">The preconditioners implemented in AMG4PSBLAS are obtained by combining 3</span>
|
||||
<span
|
||||
class="cmr-12">different types of AMG cycles with smoothers and coarsest-level solvers. Available</span>
|
||||
class="cmr-12">different types of AMG cycles with smoothers and coarsest-level solvers. We provide a</span>
|
||||
<span
|
||||
class="cmr-12">multigrid cycles include the V-, W-, and a version of a Krylov-type cycle</span>
|
||||
class="cmr-12">number of multigrid cycles, including the V-, W-, and a version of a Krylov-type cycle</span>
|
||||
<span
|
||||
class="cmr-12">(K-cycle)</span><span
|
||||
class="cmr-12"> </span><span class="cite"><span
|
||||
@@ -140,7 +140,7 @@ href="userhtmlli3.html#XDDF2020"><span
|
||||
class="cmr-12">14</span></a><span
|
||||
class="cmr-12">]</span></span><span
|
||||
class="cmr-12">.</span>
|
||||
<!--l. 30--><p class="indent" > <span
|
||||
<!--l. 34--><p class="indent" > <span
|
||||
class="cmr-12">An algebraic approach is used to generate a hierarchy of coarse-level matrices and</span>
|
||||
<span
|
||||
class="cmr-12">operators, without explicitly using any information on the geometry of the original</span>
|
||||
@@ -150,7 +150,7 @@ class="cmr-12">problem, e.g., the discretization of a PDE. To this end, two diff
|
||||
class="cmr-12">strategies, based on aggregation, are available:</span>
|
||||
<ul class="itemize1">
|
||||
<li class="itemize">
|
||||
<!--l. 35--><p class="noindent" ><span
|
||||
<!--l. 39--><p class="noindent" ><span
|
||||
class="cmr-12">a decoupled version of the smoothed aggregation procedure proposed in</span><span
|
||||
class="cmr-12"> </span><span class="cite"><span
|
||||
class="cmr-12">[</span><a
|
||||
@@ -178,7 +178,7 @@ class="cmr-12">;</span>
|
||||
|
||||
</li>
|
||||
<li class="itemize">
|
||||
<!--l. 39--><p class="noindent" ><span
|
||||
<!--l. 43--><p class="noindent" ><span
|
||||
class="cmr-12">a coupled, parallel implementation of the Coarsening based on Compatible</span>
|
||||
<span
|
||||
class="cmr-12">Weighted Matching introduced in</span><span
|
||||
@@ -198,7 +198,7 @@ href="userhtmlli3.html#XDDF2020"><span
|
||||
class="cmr-12">14</span></a><span
|
||||
class="cmr-12">]</span></span><span
|
||||
class="cmr-12">;</span></li></ul>
|
||||
<!--l. 43--><p class="noindent" ><span
|
||||
<!--l. 47--><p class="noindent" ><span
|
||||
class="cmr-12">Either exact or approximate solvers can be used on the coarsest-level system. We provide</span>
|
||||
<span
|
||||
class="cmr-12">interfaces to various parallel and sequential sparse LU factorizations from external</span>
|
||||
@@ -210,7 +210,7 @@ class="cmr-12">parallel weighted Jacobi, hybrid Gauss-Seidel, block-Jacobi solve
|
||||
class="cmr-12">preconditioned Krylov methods; all smoothers can be also exploited as one-level</span>
|
||||
<span
|
||||
class="cmr-12">preconditioners.</span>
|
||||
<!--l. 50--><p class="indent" > <span
|
||||
<!--l. 55--><p class="indent" > <span
|
||||
class="cmr-12">AMG4PSBLAS is written in Fortran</span><span
|
||||
class="cmr-12"> 2003, following an object-oriented design</span>
|
||||
<span
|
||||
@@ -225,12 +225,12 @@ class="cmr-12">Single and double precision implementations of AMG4PSBLAS are ava
|
||||
class="cmr-12">for both the real and the complex case, which can be used through a single</span>
|
||||
<span
|
||||
class="cmr-12">interface.</span>
|
||||
<!--l. 60--><p class="indent" > <span
|
||||
class="cmr-12">AMG4PSBLAS has been designed to implement scalable and easy-to-use</span>
|
||||
<!--l. 65--><p class="indent" > <span
|
||||
class="cmr-12">AMG4PSBLAS has been designed to implement scalable and easy-to-use multilevel</span>
|
||||
<span
|
||||
class="cmr-12">multilevel preconditioners in the context of the PSBLAS (Parallel Sparse BLAS)</span>
|
||||
class="cmr-12">preconditioners in the context of the PSBLAS (Parallel Sparse BLAS) computational</span>
|
||||
<span
|
||||
class="cmr-12">computational framework</span><span
|
||||
class="cmr-12">framework</span><span
|
||||
class="cmr-12"> </span><span class="cite"><span
|
||||
class="cmr-12">[</span><a
|
||||
href="userhtmlli3.html#Xpsblas_00"><span
|
||||
@@ -240,37 +240,35 @@ class="cmr-12"> </span><a
|
||||
href="userhtmlli3.html#XPSBLAS3"><span
|
||||
class="cmr-12">22</span></a><span
|
||||
class="cmr-12">]</span></span><span
|
||||
class="cmr-12">. PSBLAS provides basic linear algebra operators</span>
|
||||
class="cmr-12">. PSBLAS provides basic linear algebra operators and data</span>
|
||||
<span
|
||||
class="cmr-12">and data management facilities for distributed sparse matrices, kernels for</span>
|
||||
class="cmr-12">management facilities for distributed sparse matrices, kernels for sequential incomplete</span>
|
||||
<span
|
||||
class="cmr-12">sequential incomplete factorizations needed for the parallel block-Jacobi and</span>
|
||||
class="cmr-12">factorizations needed for the parallel block-Jacobi and additive Schwarz smoothers, and</span>
|
||||
<span
|
||||
class="cmr-12">additive Schwarz smoothers, and parallel Krylov solvers which can be used with</span>
|
||||
class="cmr-12">parallel Krylov solvers which can be used with the AMG4PSBLAS preconditioners.</span>
|
||||
<span
|
||||
class="cmr-12">the AMG4PSBLAS preconditioners. The choice of PSBLAS has been mainly</span>
|
||||
class="cmr-12">The choice of PSBLAS has been mainly motivated by the need of having a portable</span>
|
||||
<span
|
||||
class="cmr-12">motivated by the need of having a portable and efficient software infrastructure</span>
|
||||
class="cmr-12">and efficient software infrastructure implementing “de facto” standard parallel sparse</span>
|
||||
<span
|
||||
class="cmr-12">implementing “de facto” standard parallel sparse linear algebra kernels, to</span>
|
||||
class="cmr-12">linear algebra kernels, to pursue goals such as performance, portability, modularity</span>
|
||||
<span
|
||||
class="cmr-12">pursue goals such as performance, portability, modularity ed extensibility</span>
|
||||
class="cmr-12">ed extensibility in the development of the preconditioner package. On the</span>
|
||||
<span
|
||||
class="cmr-12">in the development of the preconditioner package. On the other hand, the</span>
|
||||
class="cmr-12">other hand, the implementation of AMG4PSBLAS, which was driven by the</span>
|
||||
<span
|
||||
class="cmr-12">implementation of AMG4PSBLAS, which was driven by the need to face the exascale</span>
|
||||
class="cmr-12">need to face the exascale challenge, has led to some important revisions and</span>
|
||||
<span
|
||||
class="cmr-12">challenge, has led to some important revisions and extentions of the PSBLAS</span>
|
||||
class="cmr-12">extentions of the PSBLAS infrastructure. The inter-process comunication</span>
|
||||
<span
|
||||
class="cmr-12">infrastructure. The inter-process comunication required by AMG4PSBLAS</span>
|
||||
class="cmr-12">required by AMG4PSBLAS is encapsulated in the PSBLAS routines; therefore,</span>
|
||||
<span
|
||||
class="cmr-12">is encapsulated in the PSBLAS routines; therefore, AMG4PSBLAS can be</span>
|
||||
class="cmr-12">AMG4PSBLAS can be run on any parallel machine where PSBLAS implementations</span>
|
||||
<span
|
||||
class="cmr-12">run on any parallel machine where PSBLAS implementations are available.</span>
|
||||
class="cmr-12">are available. The most recent version of PSBLAS (release 3.9) includes a plug-in for</span>
|
||||
<span
|
||||
class="cmr-12">In the most recent version of PSBLAS (release 3.7), a plug-in for GPU is</span>
|
||||
<span
|
||||
class="cmr-12">included; it includes CUDA versions of main vector operations and of sparse</span>
|
||||
class="cmr-12">GPU; it contains CUDA versions of main vector operations and of sparse</span>
|
||||
<span
|
||||
class="cmr-12">matrix-vector multiplication, so that Krylov methods coupled with AMG4PSBLAS</span>
|
||||
<span
|
||||
@@ -279,17 +277,17 @@ class="cmr-12">preconditioners relying on Jacobi and block-Jacobi smoothers with
|
||||
class="cmr-12">approximate inverses on the blocks can be efficiently executed on cluster of</span>
|
||||
<span
|
||||
class="cmr-12">GPUs.</span>
|
||||
<!--l. 85--><p class="indent" > <span
|
||||
<!--l. 90--><p class="indent" > <span
|
||||
class="cmr-12">AMG4PSBLAS has a layered and modular software architecture where three main</span>
|
||||
<span
|
||||
class="cmr-12">layers can be identified. The lower layer consists of the PSBLAS kernels, the middle</span>
|
||||
<span
|
||||
class="cmr-12">one implements the construction and application phases of the preconditioners, and the</span>
|
||||
<span
|
||||
class="cmr-12">upper one provides a uniform interface to all the preconditioners. This architecture</span>
|
||||
|
||||
|
||||
|
||||
<span
|
||||
class="cmr-12">upper one provides a uniform interface to all the preconditioners. This architecture</span>
|
||||
<span
|
||||
class="cmr-12">allows for different levels of use of the package: few black-box routines at the upper</span>
|
||||
<span
|
||||
@@ -304,7 +302,7 @@ class="cmr-12"> </span><a
|
||||
href="userhtmlse6.html#x9-310006"><span
|
||||
class="cmr-12">6</span><!--tex4ht:ref: sec:adding --></a><span
|
||||
class="cmr-12">).</span>
|
||||
<!--l. 96--><p class="indent" > <span
|
||||
<!--l. 102--><p class="indent" > <span
|
||||
class="cmr-12">This guide is organized as follows. General information on the distribution of the</span>
|
||||
<span
|
||||
class="cmr-12">source code is reported in Section</span><span
|
||||
|
||||
@@ -58,10 +58,10 @@ class="cmr-12">. Most Fortran compilers provide this feature; in particular, thi
|
||||
<span
|
||||
class="cmr-12">supported by the GNU Fortran compiler, for which we recommend to use at least</span>
|
||||
<span
|
||||
class="cmr-12">version 4.8. The software defines data types and interfaces for real and complex data,</span>
|
||||
class="cmr-12">version 12. The software defines data types and interfaces for real and complex data, in</span>
|
||||
<span
|
||||
class="cmr-12">in both single and double precision.</span>
|
||||
<!--l. 20--><p class="indent" > <span
|
||||
class="cmr-12">both single and double precision.</span>
|
||||
<!--l. 19--><p class="indent" > <span
|
||||
class="cmr-12">Building AMG4PSBLAS requires some base libraries (see Section</span><span
|
||||
class="cmr-12"> </span><a
|
||||
href="#x6-80003.1"><span
|
||||
@@ -189,7 +189,7 @@ href="https://psctoolkit.github.io/products/psblas/" ><span
|
||||
class="cmr-12">psctoolkit.github.io/ products/psblas/</span></a><span
|
||||
class="cmr-12">; version</span>
|
||||
<span
|
||||
class="cmr-12">3.7.0 (or later) is required. Indeed, all the prerequisites listed so far are also</span>
|
||||
class="cmr-12">3.9.0 (or later) is required. Indeed, all the prerequisites listed so far are also</span>
|
||||
<span
|
||||
class="cmr-12">prerequisites of PSBLAS.</span></dd></dl>
|
||||
<!--l. 60--><p class="noindent" ><span
|
||||
@@ -3911,7 +3911,7 @@ class="cmtt-12">issues</span></span><span style="color:#000000"><span
|
||||
class="cmtt-12">>.</span></span>
|
||||
</pre>
|
||||
<!--l. 160--><p class="noindent" ><span
|
||||
class="cmr-12">For instance, if a user has built and installed PSBLAS 3.7 under the </span><span class="obeylines-h"><span class="verb"><span
|
||||
class="cmr-12">For instance, if a user has built and installed PSBLAS 3.9 under the </span><span class="obeylines-h"><span class="verb"><span
|
||||
class="cmtt-12">/opt</span></span></span> <span
|
||||
class="cmr-12">directory and is</span>
|
||||
<span
|
||||
@@ -3922,7 +3922,7 @@ class="cmr-12">might be configured with:</span>
|
||||
|
||||
|
||||
<pre class="verbatim" id="verbatim-4">
|
||||
./configure --with-psblas=/opt/psblas-3.7/ \
|
||||
./configure --with-psblas=/opt/psblas-3.9/ \
|
||||
--with-umfpackincdir=/usr/include/suitesparse/
|
||||
</pre>
|
||||
<!--l. 172--><p class="nopar" > <span
|
||||
|
||||
+81
-67
@@ -199,7 +199,7 @@ class="cmr-12">.</span>
|
||||
<span
|
||||
class="cmr-12">This step is complementary to step 1 and should be performed when the</span>
|
||||
<span
|
||||
class="cmr-12">preconditioner is no more used.</span></li></ol>
|
||||
class="cmr-12">preconditioner is no longer used.</span></li></ol>
|
||||
<!--l. 59--><p class="indent" > <span
|
||||
class="cmr-12">All the previous routines are available as methods of the preconditioner object. A</span>
|
||||
<span
|
||||
@@ -351,16 +351,16 @@ class="content">Preconditioner types, corresponding strings and default choices.
|
||||
|
||||
</div><hr class="endfloat" />
|
||||
</div>
|
||||
<!--l. 98--><p class="indent" > <span
|
||||
<!--l. 97--><p class="indent" > <span
|
||||
class="cmr-12">Note that the module </span><code class="lstinline"><span style="color:#000000">amg_prec_mod</span></code><span
|
||||
class="cmr-12">, containing the definition of the preconditioner</span>
|
||||
<span
|
||||
class="cmr-12">data type and the interfaces to the routines of AMG4PSBLAS, must be used</span>
|
||||
class="cmr-12">data type and the interfaces to the routines of AMG4PSBLAS, must be used in any</span>
|
||||
<span
|
||||
class="cmr-12">in any program calling such routines. The modules </span><code class="lstinline"><span style="color:#000000">psb_base_mod</span></code><span
|
||||
class="cmr-12">, for the</span>
|
||||
class="cmr-12">program calling such routines. The modules </span><code class="lstinline"><span style="color:#000000">psb_base_mod</span></code><span
|
||||
class="cmr-12">, for the sparse</span>
|
||||
<span
|
||||
class="cmr-12">sparse matrix and communication descriptor data types, and </span><code class="lstinline"><span style="color:#000000">psb_krylov_mod</span></code><span
|
||||
class="cmr-12">matrix and communication descriptor data types, and </span><code class="lstinline"><span style="color:#000000">psb_linsolve_mod</span></code><span
|
||||
class="cmr-12">,</span>
|
||||
<span
|
||||
class="cmr-12">for interfacing with the Krylov solvers, must be also used (see Section</span><span
|
||||
@@ -370,7 +370,7 @@ class="cmr-12">4.1</span><!--tex4ht:ref: sec:examples --></a><span
|
||||
class="cmr-12">).</span>
|
||||
<br
|
||||
class="newline" />
|
||||
<!--l. 105--><p class="indent" > <span
|
||||
<!--l. 104--><p class="indent" > <span
|
||||
class="cmbx-12">Remark 1. </span><span
|
||||
class="cmr-12">Coarsest-level solvers based on the LU factorization, such as those</span>
|
||||
<span
|
||||
@@ -385,11 +385,24 @@ class="cmr-12">problems. However, this does not necessarily correspond to the sh
|
||||
<span
|
||||
class="cmr-12">on parallel</span><span
|
||||
class="cmr-12"> computers.</span>
|
||||
<!--l. 112--><p class="indent" > <span
|
||||
class="cmbx-12">Remark 2. </span><span
|
||||
class="cmr-12">Memory allocation on GPUs is a costly operation implying a</span>
|
||||
<span
|
||||
class="cmr-12">synchronization; therefore, it is convenient to preallocate internal preconditioner</span>
|
||||
<span
|
||||
class="cmr-12">workspace with the method </span><span class="obeylines-h"><span class="verb"><span
|
||||
class="cmtt-12">prec%allocate_wrk(info)</span></span></span> <span
|
||||
class="cmr-12">before invoking an iterative</span>
|
||||
<span
|
||||
class="cmr-12">method, and release it upon exit with </span><span class="obeylines-h"><span class="verb"><span
|
||||
class="cmtt-12">prec%deallocate_wrk(info)</span></span></span><span
|
||||
class="cmr-12">.</span>
|
||||
<h4 class="subsectionHead"><span class="titlemark"><span
|
||||
class="cmr-12">4.1 </span></span> <a
|
||||
id="x7-140004.1"></a><span
|
||||
class="cmr-12">Examples</span></h4>
|
||||
<!--l. 116--><p class="noindent" ><span
|
||||
<!--l. 121--><p class="noindent" ><span
|
||||
class="cmr-12">The code reported in Figure</span><span
|
||||
class="cmr-12"> </span><a
|
||||
href="#x7-14001r1"><span
|
||||
@@ -414,11 +427,11 @@ class="cmr-12">with the CG solver provided by PSBLAS (the matrix of the system t
|
||||
class="cmr-12">solved is assumed to be positive definite). As previously observed, the modules</span>
|
||||
<code class="lstinline"><span style="color:#000000">psb_base_mod</span></code><span
|
||||
class="cmr-12">, </span><code class="lstinline"><span style="color:#000000">amg_prec_mod</span></code> <span
|
||||
class="cmr-12">and </span><code class="lstinline"><span style="color:#000000">psb_krylov_mod</span></code> <span
|
||||
class="cmr-12">and </span><code class="lstinline"><span style="color:#000000">psb_linsolve_mod</span></code> <span
|
||||
class="cmr-12">must be used by the example</span>
|
||||
<span
|
||||
class="cmr-12">program.</span>
|
||||
<!--l. 126--><p class="indent" > <span
|
||||
<!--l. 131--><p class="indent" > <span
|
||||
class="cmr-12">The part of the code dealing with reading and assembling the sparse matrix and the</span>
|
||||
<span
|
||||
class="cmr-12">right-hand side vector and the deallocation of the relevant data structures, performed</span>
|
||||
@@ -451,7 +464,7 @@ href="userhtmlli3.html#XPSBLASGUIDE"><span
|
||||
class="cmr-12">21</span></a><span
|
||||
class="cmr-12">]</span></span><span
|
||||
class="cmr-12">.</span>
|
||||
<!--l. 138--><p class="indent" > <span
|
||||
<!--l. 143--><p class="indent" > <span
|
||||
class="cmr-12">The setup and application of the default multilevel preconditioner for the real single</span>
|
||||
<span
|
||||
class="cmr-12">precision and the complex, single and double precision, versions are obtained</span>
|
||||
@@ -461,6 +474,9 @@ class="cmr-12"> </span><a
|
||||
href="userhtmlse5.html#x8-160005"><span
|
||||
class="cmr-12">5</span><!--tex4ht:ref: sec:userinterface --></a> <span
|
||||
class="cmr-12">for</span>
|
||||
|
||||
|
||||
|
||||
<span
|
||||
class="cmr-12">details). If these versions are installed, the corresponding codes are available in</span>
|
||||
<span class="obeylines-h"><span class="verb"><span
|
||||
@@ -470,7 +486,7 @@ class="cmr-12">.</span>
|
||||
|
||||
|
||||
|
||||
<!--l. 144--><p class="indent" > <a
|
||||
<!--l. 148--><p class="indent" > <a
|
||||
id="x7-14001r1"></a><hr class="float"><div class="float"
|
||||
>
|
||||
|
||||
@@ -478,14 +494,14 @@ class="cmr-12">.</span>
|
||||
|
||||
<div class="center"
|
||||
>
|
||||
<!--l. 145--><p class="noindent" >
|
||||
<!--l. 149--><p class="noindent" >
|
||||
|
||||
|
||||
|
||||
<div class="minipage"><pre class="verbatim" id="verbatim-7">
|
||||
  use psb_base_mod
|
||||
  use amg_prec_mod
|
||||
  use psb_krylov_mod
|
||||
  use psb_linsolve_mod
|
||||
... ...
|
||||
!
|
||||
! sparse matrix
|
||||
@@ -535,7 +551,7 @@ class="cmr-12">.</span>
|
||||
  call psb_exit(ctxt)
|
||||
  stop
|
||||
</pre>
|
||||
<!--l. 255--><p class="nopar" > </div>
|
||||
<!--l. 259--><p class="nopar" > </div>
|
||||
|
||||
|
||||
|
||||
@@ -548,7 +564,7 @@ class="content">setup and application of the default multilevel preconditioner (
|
||||
|
||||
|
||||
</div><hr class="endfloat" />
|
||||
<!--l. 264--><p class="indent" > <span
|
||||
<!--l. 267--><p class="indent" > <span
|
||||
class="cmr-12">Different versions of the multilevel preconditioner can be obtained by changing the</span>
|
||||
<span
|
||||
class="cmr-12">default values of the preconditioner parameters. The code reported in Figure</span><span
|
||||
@@ -557,42 +573,40 @@ href="#x7-14002r2"><span
|
||||
class="cmr-12">2</span><!--tex4ht:ref: fig:ex2 --></a> <span
|
||||
class="cmr-12">shows</span>
|
||||
<span
|
||||
class="cmr-12">how to set a V-cycle preconditioner which applies 1 block-Jacobi sweep as pre-</span>
|
||||
class="cmr-12">how to set a V-cycle preconditioner which applies 1 block-Jacobi sweep as pre- and</span>
|
||||
<span
|
||||
class="cmr-12">and post-smoother, and solves the coarsest-level system with 8 block-Jacobi</span>
|
||||
class="cmr-12">post-smoother, and solves the coarsest-level system with 8 block-Jacobi sweeps. Note</span>
|
||||
<span
|
||||
class="cmr-12">sweeps. Note that the ILU(0) factorization (plus triangular solve) is used as</span>
|
||||
class="cmr-12">that the ILU(0) factorization (plus triangular solve) is used as local solver for the</span>
|
||||
<span
|
||||
class="cmr-12">local solver for the block-Jacobi sweeps, since this is the default associated</span>
|
||||
class="cmr-12">block-Jacobi sweeps, since this is the default associated with block-Jacobi and set</span>
|
||||
<span
|
||||
class="cmr-12">with block-Jacobi and set by</span><span
|
||||
class="cmr-12">by</span><span
|
||||
class="cmr-12"> </span><code class="lstinline"><span style="color:#000000">P</span><span style="color:#000000">%</span><span style="color:#000000">init</span></code><span
|
||||
class="cmr-12">. Furthermore, specifying block-Jacobi as</span>
|
||||
class="cmr-12">. Furthermore, specifying block-Jacobi as coarsest-level solver implies that</span>
|
||||
<span
|
||||
class="cmr-12">coarsest-level solver implies that the coarsest-level matrix is distributed among</span>
|
||||
<span
|
||||
class="cmr-12">the processes. Figure</span><span
|
||||
class="cmr-12">the coarsest-level matrix is distributed among the processes. Figure</span><span
|
||||
class="cmr-12"> </span><a
|
||||
href="#x7-14003r3"><span
|
||||
class="cmr-12">3</span><!--tex4ht:ref: fig:ex3 --></a> <span
|
||||
class="cmr-12">shows how to set a W-cycle preconditioner using the</span>
|
||||
class="cmr-12">shows how</span>
|
||||
<span
|
||||
class="cmr-12">Coarsening based on Compatible Weighted Matching, aggregates of size at</span>
|
||||
class="cmr-12">to set a W-cycle preconditioner using the Coarsening based on Compatible</span>
|
||||
<span
|
||||
class="cmr-12">most 8 and smoothed prolongators. It applies 2 hybrid Gauss-Seidel sweeps as</span>
|
||||
class="cmr-12">Weighted Matching, aggregates of size at most 8 and smoothed prolongators. It</span>
|
||||
<span
|
||||
class="cmr-12">pre- and post-smoother, and solves the coarsest-level system with the parallel</span>
|
||||
class="cmr-12">applies 2 hybrid Gauss-Seidel sweeps as pre- and post-smoother, and solves the</span>
|
||||
<span
|
||||
class="cmr-12">flexible Conjugate Gradient method (KRM) coupled with the block-Jacobi</span>
|
||||
class="cmr-12">coarsest-level system with the parallel flexible Conjugate Gradient method (KRM)</span>
|
||||
<span
|
||||
class="cmr-12">preconditioner having ILU(0) on the blocks. Default parameters are used for stopping</span>
|
||||
class="cmr-12">coupled with the block-Jacobi preconditioner having ILU(0) on the blocks, with</span>
|
||||
<span
|
||||
class="cmr-12">criterion of the coarsest solver. Note that, also in this case, specifying KRM as</span>
|
||||
class="cmr-12">default parameters used for the coarsest solver. Note that specifying KRM as</span>
|
||||
<span
|
||||
class="cmr-12">coarsest-level solver implies that the coarsest-level matrix is distributed among the</span>
|
||||
<span
|
||||
class="cmr-12">processes.</span>
|
||||
<!--l. 291--><p class="indent" > <span
|
||||
<!--l. 299--><p class="indent" > <span
|
||||
class="cmr-12">The code fragments shown in Figures</span><span
|
||||
class="cmr-12"> </span><a
|
||||
href="#x7-14002r2"><span
|
||||
@@ -605,7 +619,7 @@ class="cmr-12">are included in the example program</span>
|
||||
class="cmr-12">file </span><span class="obeylines-h"><span class="verb"><span
|
||||
class="cmtt-12">amg_dexample_ml.f90</span></span></span> <span
|
||||
class="cmr-12">too.</span>
|
||||
<!--l. 294--><p class="indent" > <span
|
||||
<!--l. 302--><p class="indent" > <span
|
||||
class="cmr-12">Finally, Figure</span><span
|
||||
class="cmr-12"> </span><a
|
||||
href="#x7-14004r4"><span
|
||||
@@ -620,7 +634,7 @@ class="cmr-12">nonsymmetric. The corresponding example program is available in t
|
||||
<span class="obeylines-h"><span class="verb"><span
|
||||
class="cmtt-12">amg_dexample_1lev.f90</span></span></span><span
|
||||
class="cmr-12">.</span>
|
||||
<!--l. 301--><p class="indent" > <span
|
||||
<!--l. 309--><p class="indent" > <span
|
||||
class="cmr-12">For all the previous preconditioners, example programs where the sparse matrix</span>
|
||||
<span
|
||||
class="cmr-12">and the right-hand side are generated by discretizing a PDE with Dirichlet</span>
|
||||
@@ -631,7 +645,7 @@ class="cmr-12">.</span>
|
||||
|
||||
|
||||
|
||||
<!--l. 304--><p class="indent" > <a
|
||||
<!--l. 312--><p class="indent" > <a
|
||||
id="x7-14002r2"></a><hr class="float"><div class="float"
|
||||
>
|
||||
|
||||
@@ -639,7 +653,7 @@ class="cmr-12">.</span>
|
||||
|
||||
<div class="center"
|
||||
>
|
||||
<!--l. 318--><p class="noindent" >
|
||||
<!--l. 326--><p class="noindent" >
|
||||
<div class="minipage"><pre class="verbatim" id="verbatim-8">
|
||||
... ...
|
||||
! build a V-cycle preconditioner with 1 block-Jacobi sweep (with
|
||||
@@ -653,7 +667,7 @@ class="cmr-12">.</span>
|
||||
  call P%smoothers_build(A,desc_A,info)
|
||||
... ...
|
||||
</pre>
|
||||
<!--l. 333--><p class="nopar" > </div></div>
|
||||
<!--l. 341--><p class="nopar" > </div></div>
|
||||
<br /><div class="caption"
|
||||
><span class="id">Listing 2: </span><span
|
||||
class="content">setup of a multilevel preconditioner based on the default decoupled coarsening</span></div><!--tex4ht:label?: x7-14002r2 -->
|
||||
@@ -664,7 +678,7 @@ class="content">setup of a multilevel preconditioner based on the default decoup
|
||||
|
||||
|
||||
|
||||
<!--l. 340--><p class="indent" > <a
|
||||
<!--l. 348--><p class="indent" > <a
|
||||
id="x7-14003r3"></a><hr class="float"><div class="float"
|
||||
>
|
||||
|
||||
@@ -672,7 +686,7 @@ class="content">setup of a multilevel preconditioner based on the default decoup
|
||||
|
||||
<div class="center"
|
||||
>
|
||||
<!--l. 362--><p class="noindent" >
|
||||
<!--l. 370--><p class="noindent" >
|
||||
<div class="minipage"><pre class="verbatim" id="verbatim-9">
|
||||
... ...
|
||||
! build a W-cycle preconditioner with 2 hybrid Gauss-Seidel sweeps
|
||||
@@ -692,7 +706,7 @@ class="content">setup of a multilevel preconditioner based on the default decoup
|
||||
  call P%smoothers_build(A,desc_A,info)
|
||||
... ...
|
||||
</pre>
|
||||
<!--l. 383--><p class="nopar" > </div></div>
|
||||
<!--l. 391--><p class="nopar" > </div></div>
|
||||
<br /> <div class="caption"
|
||||
><span class="id">Listing 3: </span><span
|
||||
class="content">setup of a multilevel preconditioner based on the coupled coarsening using
|
||||
@@ -704,7 +718,7 @@ weighted matching</span></div><!--tex4ht:label?: x7-14003r3 -->
|
||||
|
||||
|
||||
|
||||
<!--l. 390--><p class="indent" > <a
|
||||
<!--l. 398--><p class="indent" > <a
|
||||
id="x7-14004r4"></a><hr class="float"><div class="float"
|
||||
>
|
||||
|
||||
@@ -712,7 +726,7 @@ weighted matching</span></div><!--tex4ht:label?: x7-14003r3 -->
|
||||
|
||||
<div class="center"
|
||||
>
|
||||
<!--l. 402--><p class="noindent" >
|
||||
<!--l. 410--><p class="noindent" >
|
||||
<div class="minipage"><pre class="verbatim" id="verbatim-10">
|
||||
... ...
|
||||
! set RAS with overlap 2 and ILU(0) on the local blocks
|
||||
@@ -723,7 +737,7 @@ weighted matching</span></div><!--tex4ht:label?: x7-14003r3 -->
|
||||
! solve Ax=b with preconditioned BiCGSTAB
|
||||
  call psb_krylov(’BICGSTAB’,A,P,b,x,tol,desc_A,info)
|
||||
</pre>
|
||||
<!--l. 414--><p class="nopar" > </div></div>
|
||||
<!--l. 422--><p class="nopar" > </div></div>
|
||||
<br /> <div class="caption"
|
||||
><span class="id">Listing 4: </span><span
|
||||
class="content">setup of a one-level Schwarz preconditioner.</span></div><!--tex4ht:label?: x7-14004r4 -->
|
||||
@@ -735,7 +749,7 @@ class="content">setup of a one-level Schwarz preconditioner.</span></div><!--tex
|
||||
class="cmr-12">4.2 </span></span> <a
|
||||
id="x7-150004.2"></a><span
|
||||
class="cmr-12">GPU example</span></h4>
|
||||
<!--l. 426--><p class="noindent" ><span
|
||||
<!--l. 434--><p class="noindent" ><span
|
||||
class="cmr-12">The code discussed here shows how to set up a program exploiting the combined GPU</span>
|
||||
<span
|
||||
class="cmr-12">capabilities of PSBLAS and AMG4PSBLAS. The code example is available in the</span>
|
||||
@@ -743,14 +757,14 @@ class="cmr-12">capabilities of PSBLAS and AMG4PSBLAS. The code example is availa
|
||||
class="cmr-12">source distribution directory </span><span class="obeylines-h"><span class="verb"><span
|
||||
class="cmtt-12">amg4psblas/examples/gpu</span></span></span><span
|
||||
class="cmr-12">.</span>
|
||||
<!--l. 431--><p class="indent" > <span
|
||||
<!--l. 439--><p class="indent" > <span
|
||||
class="cmr-12">First of all, we need to include the appropriate modules and declare some auxiliary</span>
|
||||
<span
|
||||
class="cmr-12">variables:</span>
|
||||
|
||||
|
||||
|
||||
<!--l. 433--><p class="indent" > <a
|
||||
<!--l. 441--><p class="indent" > <a
|
||||
id="x7-15001r5"></a><hr class="float"><div class="float"
|
||||
>
|
||||
|
||||
@@ -758,12 +772,12 @@ class="cmr-12">variables:</span>
|
||||
|
||||
<div class="center"
|
||||
>
|
||||
<!--l. 452--><p class="noindent" >
|
||||
<!--l. 460--><p class="noindent" >
|
||||
<div class="minipage"><pre class="verbatim" id="verbatim-11">
|
||||
program amg_dexample_gpu
|
||||
  use psb_base_mod
|
||||
  use amg_prec_mod
|
||||
  use psb_krylov_mod
|
||||
  use psb_linsolve_mod
|
||||
  use psb_util_mod
|
||||
  use psb_gpu_mod
|
||||
  use data_input
|
||||
@@ -777,7 +791,7 @@ program amg_dexample_gpu
|
||||
|
||||
 
|
||||
</pre>
|
||||
<!--l. 471--><p class="nopar" > </div></div>
|
||||
<!--l. 479--><p class="nopar" > </div></div>
|
||||
<br /> <div class="caption"
|
||||
><span class="id">Listing 5: </span><span
|
||||
class="content">setup of a GPU-enabled test program part one.</span></div><!--tex4ht:label?: x7-15001r5 -->
|
||||
@@ -785,7 +799,7 @@ class="content">setup of a GPU-enabled test program part one.</span></div><!--te
|
||||
|
||||
|
||||
</div><hr class="endfloat" />
|
||||
<!--l. 478--><p class="indent" > <span
|
||||
<!--l. 486--><p class="indent" > <span
|
||||
class="cmr-12">In this particular example we are choosing to employ a </span><span class="obeylines-h"><span class="verb"><span
|
||||
class="cmtt-12">HLG</span></span></span> <span
|
||||
class="cmr-12">data structure for</span>
|
||||
@@ -793,14 +807,14 @@ class="cmr-12">data structure for</span>
|
||||
class="cmr-12">sparse matrices on GPUs; for more information please refer to the PSBLAS users’</span>
|
||||
<span
|
||||
class="cmr-12">guide.</span>
|
||||
<!--l. 482--><p class="indent" > <span
|
||||
<!--l. 490--><p class="indent" > <span
|
||||
class="cmr-12">We then have to initialize the GPU environment, and pass the appropriate MOLD</span>
|
||||
<span
|
||||
class="cmr-12">variables to the build methods (see also the PSBLAS users’ guide).</span>
|
||||
|
||||
|
||||
|
||||
<!--l. 485--><p class="indent" > <a
|
||||
<!--l. 493--><p class="indent" > <a
|
||||
id="x7-15002r6"></a><hr class="float"><div class="float"
|
||||
>
|
||||
|
||||
@@ -808,7 +822,7 @@ class="cmr-12">variables to the build methods (see also the PSBLAS users’
|
||||
|
||||
<div class="center"
|
||||
>
|
||||
<!--l. 501--><p class="noindent" >
|
||||
<!--l. 509--><p class="noindent" >
|
||||
<div class="minipage"><pre class="verbatim" id="verbatim-12">
|
||||
  call psb_init(ctxt)
|
||||
  call psb_info(ctxt,iam,np)
|
||||
@@ -823,7 +837,7 @@ class="cmr-12">variables to the build methods (see also the PSBLAS users’
|
||||
|
||||
 
|
||||
</pre>
|
||||
<!--l. 516--><p class="nopar" > </div></div>
|
||||
<!--l. 524--><p class="nopar" > </div></div>
|
||||
<br /> <div class="caption"
|
||||
><span class="id">Listing 6: </span><span
|
||||
class="content">setup of a GPU-enabled test program part two.</span></div><!--tex4ht:label?: x7-15002r6 -->
|
||||
@@ -831,7 +845,7 @@ class="content">setup of a GPU-enabled test program part two.</span></div><!--te
|
||||
|
||||
|
||||
</div><hr class="endfloat" />
|
||||
<!--l. 523--><p class="indent" > <span
|
||||
<!--l. 531--><p class="indent" > <span
|
||||
class="cmr-12">Finally, we convert the input matrix, the descriptor and the vectors to use a</span>
|
||||
<span
|
||||
class="cmr-12">GPU-enabled internal storage format. We then preallocate the preconditioner</span>
|
||||
@@ -842,7 +856,7 @@ class="cmr-12">GPU environment</span>
|
||||
|
||||
|
||||
|
||||
<!--l. 527--><p class="indent" > <a
|
||||
<!--l. 535--><p class="indent" > <a
|
||||
id="x7-15003r7"></a><hr class="float"><div class="float"
|
||||
>
|
||||
|
||||
@@ -850,7 +864,7 @@ class="cmr-12">GPU environment</span>
|
||||
|
||||
<div class="center"
|
||||
>
|
||||
<!--l. 557--><p class="noindent" >
|
||||
<!--l. 565--><p class="noindent" >
|
||||
<div class="minipage"><pre class="verbatim" id="verbatim-13">
|
||||
  call desc_a%cnv(mold=igmold)
|
||||
  call a%cscnv(info,mold=agmold)
|
||||
@@ -877,7 +891,7 @@ class="cmr-12">GPU environment</span>
|
||||
|
||||
 
|
||||
</pre>
|
||||
<!--l. 584--><p class="nopar" > </div></div>
|
||||
<!--l. 592--><p class="nopar" > </div></div>
|
||||
<br /> <div class="caption"
|
||||
><span class="id">Listing 7: </span><span
|
||||
class="content">setup of a GPU-enabled test program part three.</span></div><!--tex4ht:label?: x7-15003r7 -->
|
||||
@@ -885,7 +899,7 @@ class="content">setup of a GPU-enabled test program part three.</span></div><!--
|
||||
|
||||
|
||||
</div><hr class="endfloat" />
|
||||
<!--l. 592--><p class="indent" > <span
|
||||
<!--l. 600--><p class="indent" > <span
|
||||
class="cmr-12">It is very important to employ smoothers and coarsest solvers that are suited to the</span>
|
||||
<span
|
||||
class="cmr-12">GPU, i.e. methods that do NOT employ triangular system solve kernels. Methods that</span>
|
||||
@@ -893,30 +907,30 @@ class="cmr-12">GPU, i.e. methods that do NOT employ triangular system solve kern
|
||||
class="cmr-12">satisfy this constraint include:</span>
|
||||
<ul class="itemize1">
|
||||
<li class="itemize">
|
||||
<!--l. 596--><p class="noindent" ><span class="obeylines-h"><span class="verb"><span
|
||||
<!--l. 604--><p class="noindent" ><span class="obeylines-h"><span class="verb"><span
|
||||
class="cmtt-12">JACOBI</span></span></span>
|
||||
</li>
|
||||
<li class="itemize">
|
||||
<!--l. 597--><p class="noindent" ><span class="obeylines-h"><span class="verb"><span
|
||||
<!--l. 605--><p class="noindent" ><span class="obeylines-h"><span class="verb"><span
|
||||
class="cmtt-12">BJAC</span></span></span> <span
|
||||
class="cmr-12">with the following methods on the local blocks:</span>
|
||||
<ul class="itemize2">
|
||||
<li class="itemize">
|
||||
<!--l. 599--><p class="noindent" ><span class="obeylines-h"><span class="verb"><span
|
||||
<!--l. 607--><p class="noindent" ><span class="obeylines-h"><span class="verb"><span
|
||||
class="cmtt-12">INVK</span></span></span>
|
||||
</li>
|
||||
<li class="itemize">
|
||||
<!--l. 600--><p class="noindent" ><span class="obeylines-h"><span class="verb"><span
|
||||
<!--l. 608--><p class="noindent" ><span class="obeylines-h"><span class="verb"><span
|
||||
class="cmtt-12">INVT</span></span></span>
|
||||
</li>
|
||||
<li class="itemize">
|
||||
<!--l. 601--><p class="noindent" ><span class="obeylines-h"><span class="verb"><span
|
||||
<!--l. 609--><p class="noindent" ><span class="obeylines-h"><span class="verb"><span
|
||||
class="cmtt-12">AINV</span></span></span></li></ul>
|
||||
</li>
|
||||
<li class="itemize">
|
||||
<!--l. 603--><p class="noindent" ><span class="obeylines-h"><span class="verb"><span
|
||||
<!--l. 611--><p class="noindent" ><span class="obeylines-h"><span class="verb"><span
|
||||
class="cmtt-12">POLY</span></span></span></li></ul>
|
||||
<!--l. 605--><p class="noindent" ><span
|
||||
<!--l. 613--><p class="noindent" ><span
|
||||
class="cmr-12">and their </span><span
|
||||
class="cmmi-12">ℓ</span><sub><span
|
||||
class="cmr-8">1</span></sub> <span
|
||||
|
||||
+653
-652
File diff suppressed because it is too large
Load Diff
@@ -64,6 +64,10 @@ class="cmr-12">.</span>
|
||||
|
||||
|
||||
|
||||
<!--l. 148--><p class="indent" >
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
+34
-33
@@ -38,46 +38,47 @@ class="cmr-12">AMG4PSBLAS is freely distributable under the following copyright
|
||||
|
||||
<pre class="verbatim" id="verbatim-15">
|
||||
|
||||
                           AMG4PSBLAS  version 1.0
|
||||
              Algebraic MultiGrid Preconditioners Package
|
||||
             based on PSBLAS (Parallel Sparse BLAS version 3.7)
|
||||
|
||||
  (C) Copyright 2021
|
||||
                             AMG4PSBLAS version 1.2
|
||||
    Algebraic Multigrid Package
|
||||
               based on PSBLAS (Parallel Sparse BLAS version 3.9)
|
||||
|
||||
  Pasqua D’Ambra         IAC-CNR, IT
|
||||
  Fabio Durastante       University of Pisa and IAC-CNR, IT
|
||||
  Salvatore Filippone    University of Rome Tor-Vergata and IAC-CNR, IT
|
||||
    (C) Copyright 2025
|
||||
|
||||
  Redistribution and use in source and binary forms, with or without
|
||||
  modification, are permitted provided that the following conditions
|
||||
  are met:
|
||||
    1. Redistributions of source code must retain the above copyright
|
||||
       notice, this list of conditions and the following disclaimer.
|
||||
    2. Redistributions in binary form must reproduce the above copyright
|
||||
       notice, this list of conditions, and the following disclaimer in the
|
||||
       documentation and/or other materials provided with the distribution.
|
||||
    3. The name of the MLD2P4 group or the names of its contributors may
|
||||
       not be used to endorse or promote products derived from this
|
||||
       software without specific written permission.
|
||||
        Salvatore Filippone
|
||||
        Pasqua D’Ambra
|
||||
        Fabio Durastante
|
||||
|
||||
  THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
  ‘‘AS IS’’ AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
  TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
|
||||
  PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS
|
||||
  BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
|
||||
  CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
|
||||
  SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
|
||||
  INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
|
||||
  CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
|
||||
  ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
|
||||
  POSSIBILITY OF SUCH DAMAGE.
|
||||
    Redistribution and use in source and binary forms, with or without
|
||||
    modification, are permitted provided that the following conditions
|
||||
    are met:
|
||||
      1. Redistributions of source code must retain the above copyright
|
||||
         notice, this list of conditions and the following disclaimer.
|
||||
      2. Redistributions in binary form must reproduce the above copyright
|
||||
         notice, this list of conditions, and the following disclaimer in the
|
||||
         documentation and/or other materials provided with the distribution.
|
||||
      3. The name of the AMG4PSBLAS group or the names of its contributors may
|
||||
         not be used to endorse or promote products derived from this
|
||||
         software without specific written permission.
|
||||
|
||||
    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
    ‘‘AS IS’’ AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
    TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
|
||||
    PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AMG4PSBLAS GROUP OR ITS CONTRIBUTORS
|
||||
    BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
|
||||
    CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
|
||||
    SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
|
||||
    INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
|
||||
    CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
|
||||
    ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
|
||||
    POSSIBILITY OF SUCH DAMAGE.
|
||||
|
||||
</pre>
|
||||
<!--l. 44--><p class="nopar" >
|
||||
<!--l. 45--><p class="nopar" >
|
||||
|
||||
|
||||
|
||||
<!--l. 47--><p class="indent" > <span
|
||||
<!--l. 48--><p class="indent" > <span
|
||||
class="cmr-12">AMG4PSBLAS is an evolution of MLD2P4, whose license we reproduce here to</span>
|
||||
<span
|
||||
class="cmr-12">abide by its terms:</span>
|
||||
@@ -123,7 +124,7 @@ class="cmr-12">abide by its terms:</span>
|
||||
  POSSIBILITY OF SUCH DAMAGE.
|
||||
|
||||
</pre>
|
||||
<!--l. 87--><p class="nopar" > <span
|
||||
<!--l. 88--><p class="nopar" > <span
|
||||
class="cmr-12">AMG4PSBLAS is distributed together with (a small part of) the graph-matching</span>
|
||||
|
||||
|
||||
@@ -183,7 +184,7 @@ class="cmr-12">here.</span>
|
||||
//
|
||||
// ************************************************************************
|
||||
</pre>
|
||||
<!--l. 135--><p class="nopar" >
|
||||
<!--l. 136--><p class="nopar" >
|
||||
|
||||
|
||||
|
||||
|
||||
+27
-15
@@ -4,30 +4,42 @@
|
||||
\fi
|
||||
|
||||
\textsc{AMG4PSBLAS (Algebraic MultiGrid Preconditioners Package
|
||||
based on PSBLAS}) 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
|
||||
based on PSBLAS}) is a package of parallel algebraic multilevel
|
||||
preconditioners included in the PSCToolkit (Parallel Sparse
|
||||
Computation Toolkit) software framework.
|
||||
It is an evolutiuon 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.
|
||||
In the last years, within the context of the EU-H2020 EoCoE project (Energy Oriented Center of Excellence), 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.
|
||||
Due to the significant number of changes and the increase in scope, we decided to rename the package as AMG4PSBLAS.
|
||||
In the last few 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; these
|
||||
developments have been supported in the context of the EU-H2020 EoCoE
|
||||
project (Energy Oriented Center of Excellence).
|
||||
Due to the significant number of changes and the increase 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.
|
||||
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.
|
||||
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~2003, with interfaces to additional third party libraries
|
||||
Fortran~2003, 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
|
||||
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.
|
||||
|
||||
+10
-10
@@ -12,20 +12,20 @@ interfaces to external libraries in C; the Fortran compiler
|
||||
must support the Fortran~2003 standard plus the extension \verb|MOLD=|
|
||||
feature, which enhances the usability of \verb|ALLOCATE|.
|
||||
Most Fortran compilers provide this feature; in particular, this is
|
||||
supported by the GNU Fortran compiler, for which we
|
||||
recommend to use at least version 4.8.
|
||||
supported by the GNU Fortran compiler, for which we recommend to use at least version 12.
|
||||
The software defines data types and interfaces for
|
||||
real and complex data, in both single and double precision.
|
||||
|
||||
Building AMG4PSBLAS requires some base libraries (see
|
||||
Section~\ref{sec:prerequisites}); interfaces to optional third-party
|
||||
Section~\ref{sec:prerequisites}); interfaces to optional third-party
|
||||
libraries, which extend the functionalities of AMG4PSBLAS (see
|
||||
Section~\ref{sec:third-party}), are also available. A number of Linux
|
||||
distributions (e.g., Ubuntu, Fedora, CentOS) provide precompiled
|
||||
Section~\ref{sec:third-party}), are also available. A number of Linux
|
||||
distributions (e.g., Ubuntu, Fedora, CentOS) provide precompiled
|
||||
packages for the prerequisite and optional software. In many cases
|
||||
these packages are split between a runtime part and a ``developer''
|
||||
part; in order to build AMG4PSBLAS you need both. A description of the
|
||||
base and optional software used by AMG4PSBLAS is given in the next sections.
|
||||
base and optional software used by AMG4PSBLAS is given in the next
|
||||
sections.
|
||||
|
||||
\subsection{Prerequisites\label{sec:prerequisites}}
|
||||
|
||||
@@ -53,7 +53,7 @@ in the make.inc file of the LAPACK library.
|
||||
\item[PSBLAS] \cite{PSBLASGUIDE,psblas_00} Parallel Sparse BLAS (PSBLAS) is
|
||||
available from
|
||||
\href{https://psctoolkit.github.io/products/psblas/}{psctoolkit.github.io/
|
||||
products/psblas/}; version 3.7.0 (or later) is
|
||||
products/psblas/}; version 3.9.0 (or later) is
|
||||
required. Indeed, all the prerequisites listed so far are also
|
||||
prerequisites of PSBLAS.
|
||||
\end{description}
|
||||
@@ -157,17 +157,17 @@ The full set of options may be looked at by issuing the command
|
||||
\else
|
||||
\lstinputlisting{../configureout.txt}
|
||||
\fi
|
||||
For instance, if a user has built and installed PSBLAS 3.7 under the
|
||||
For instance, if a user has built and installed PSBLAS 3.9 under the
|
||||
\verb|/opt| directory and is
|
||||
using the SuiteSparse package (which includes UMFPACK), then AMG4PSBLAS
|
||||
might be configured with:
|
||||
\ifpdf
|
||||
\begin{minted}[breaklines=true,bgcolor=bg,fontsize=\small]{console}
|
||||
./configure --with-psblas=/opt/psblas-3.7/ --with-umfpackincdir=/usr/include/suitesparse/
|
||||
./configure --with-psblas=/opt/psblas-3.9/ --with-umfpackincdir=/usr/include/suitesparse/
|
||||
\end{minted}
|
||||
\else
|
||||
\begin{verbatim}
|
||||
./configure --with-psblas=/opt/psblas-3.7/ \
|
||||
./configure --with-psblas=/opt/psblas-3.9/ \
|
||||
--with-umfpackincdir=/usr/include/suitesparse/
|
||||
\end{verbatim}
|
||||
\fi
|
||||
|
||||
+21
-13
@@ -53,7 +53,7 @@ performed by the routine \fortinline|bld|.
|
||||
by the PSBLAS routine implementing the Krylov solver (\fortinline|psb_krylov|).
|
||||
\item \emph{Free the preconditioner data structure}. This is performed by
|
||||
the routine \fortinline|free|. This step is complementary to step 1 and should
|
||||
be performed when the preconditioner is no more used.
|
||||
be performed when the preconditioner is no longer used.
|
||||
\end{enumerate}
|
||||
|
||||
All the previous routines are available as methods of the preconditioner object.
|
||||
@@ -94,12 +94,11 @@ Multilevel &\fortinline|'ML'| & V-cycle with one hybrid forward Gauss-
|
||||
\label{tab:precinit}}
|
||||
\end{center}
|
||||
\end{table}
|
||||
|
||||
Note that the module \fortinline|amg_prec_mod|, containing the definition of the
|
||||
preconditioner data type and the interfaces to the routines of AMG4PSBLAS,
|
||||
must be used in any program calling such routines.
|
||||
The modules \fortinline|psb_base_mod|, for the sparse matrix and communication descriptor
|
||||
data types, and \fortinline|psb_krylov_mod|, for interfacing with the
|
||||
data types, and \fortinline|psb_linsolve_mod|, for interfacing with the
|
||||
Krylov solvers, must be also used (see Section~\ref{sec:examples}). \\
|
||||
|
||||
\textbf{Remark 1.} Coarsest-level solvers based on the LU factorization,
|
||||
@@ -110,6 +109,12 @@ a standard discretization of basic scalar elliptic PDE problems. However,
|
||||
this does not necessarily correspond to the shortest execution time
|
||||
on parallel~computers.
|
||||
|
||||
\textbf{Remark 2.} Memory allocation on GPUs is a costly operation
|
||||
implying a synchronization; therefore, it is convenient to preallocate
|
||||
internal preconditioner workspace with the method
|
||||
\verb|prec%allocate_wrk(info)| before invoking an iterative method,
|
||||
and release it upon exit with \verb|prec%deallocate_wrk(info)|.
|
||||
|
||||
|
||||
\subsection{Examples\label{sec:examples}}
|
||||
|
||||
@@ -120,7 +125,7 @@ by simply specifying \fortinline|'ML'| as the second argument of \fortinline|P%i
|
||||
(a call to \fortinline|P%set| is not needed) and is applied with the CG
|
||||
solver provided by PSBLAS (the matrix of the system to be solved is
|
||||
assumed to be positive definite). As previously observed, the modules
|
||||
\fortinline|psb_base_mod|, \fortinline|amg_prec_mod| and \fortinline|psb_krylov_mod|
|
||||
\fortinline|psb_base_mod|, \fortinline|amg_prec_mod| and \fortinline|psb_linsolve_mod|
|
||||
must be used by the example program.
|
||||
|
||||
The part of the code dealing with reading and assembling the sparse
|
||||
@@ -140,7 +145,6 @@ for the real single precision and the complex, single and double
|
||||
precision, versions are obtained with straightforward modifications of the previous
|
||||
example (see Section~\ref{sec:userinterface} for details). If these versions are installed,
|
||||
the corresponding codes are available in \verb|samples/simple/file|\-\verb|read|.
|
||||
|
||||
\begin{listing}[tbp]
|
||||
\begin{center}
|
||||
\begin{minipage}{.90\textwidth}
|
||||
@@ -148,7 +152,7 @@ the corresponding codes are available in \verb|samples/simple/file|\-\verb|read|
|
||||
\begin{minted}[breaklines=true,bgcolor=bg,fontsize=\small]{fortran}
|
||||
use psb_base_mod
|
||||
use amg_prec_mod
|
||||
use psb_krylov_mod
|
||||
use psb_linsolve_mod
|
||||
... ...
|
||||
!
|
||||
! sparse matrix
|
||||
@@ -203,7 +207,7 @@ stop
|
||||
\begin{verbatim}
|
||||
use psb_base_mod
|
||||
use amg_prec_mod
|
||||
use psb_krylov_mod
|
||||
use psb_linsolve_mod
|
||||
... ...
|
||||
!
|
||||
! sparse matrix
|
||||
@@ -260,7 +264,6 @@ stop
|
||||
\label{fig:ex1}}
|
||||
\end{center}
|
||||
\end{listing}
|
||||
|
||||
Different versions of the multilevel preconditioner can be obtained by changing
|
||||
the default values of the preconditioner parameters. The code reported in
|
||||
Figure~\ref{fig:ex2} shows how to set a V-cycle preconditioner
|
||||
@@ -272,10 +275,15 @@ with block-Jacobi and set by~\fortinline|P%init|.
|
||||
Furthermore, specifying block-Jacobi as coarsest-level
|
||||
solver implies that the coarsest-level matrix is distributed
|
||||
among the processes.
|
||||
Figure~\ref{fig:ex3} shows how to set a W-cycle preconditioner using the Coarsening based on Compatible Weighted Matching, aggregates of size at most $8$ and smoothed prolongators. It applies
|
||||
Figure~\ref{fig:ex3} shows how to set a W-cycle preconditioner using
|
||||
the Coarsening based on Compatible Weighted Matching, aggregates of
|
||||
size at most $8$ and smoothed prolongators. It applies
|
||||
2 hybrid Gauss-Seidel sweeps as pre- and post-smoother,
|
||||
and solves the coarsest-level system with the parallel flexible Conjugate Gradient method (KRM) coupled with the block-Jacobi preconditioner having ILU(0) on the blocks. Default parameters are used for stopping criterion of the coarsest solver.
|
||||
Note that, also in this case, specifying KRM as coarsest-level
|
||||
and solves the coarsest-level system with the parallel flexible
|
||||
Conjugate Gradient method (KRM) coupled with the block-Jacobi
|
||||
preconditioner having ILU(0) on the blocks, with default parameters
|
||||
used for the coarsest solver.
|
||||
Note that specifying KRM as coarsest-level
|
||||
solver implies that the coarsest-level matrix is distributed
|
||||
among the processes.
|
||||
%It is specified that the coarsest-level
|
||||
@@ -436,7 +444,7 @@ declare some auxiliary variables:
|
||||
program amg_dexample_gpu
|
||||
use psb_base_mod
|
||||
use amg_prec_mod
|
||||
use psb_krylov_mod
|
||||
use psb_linsolve_mod
|
||||
use psb_util_mod
|
||||
use psb_gpu_mod
|
||||
use data_input
|
||||
@@ -456,7 +464,7 @@ program amg_dexample_gpu
|
||||
program amg_dexample_gpu
|
||||
use psb_base_mod
|
||||
use amg_prec_mod
|
||||
use psb_krylov_mod
|
||||
use psb_linsolve_mod
|
||||
use psb_util_mod
|
||||
use psb_gpu_mod
|
||||
use data_input
|
||||
|
||||
+35
-34
@@ -6,40 +6,41 @@
|
||||
AMG4PSBLAS is freely distributable under the following copyright
|
||||
terms: {\small
|
||||
\begin{verbatim}
|
||||
|
||||
AMG4PSBLAS version 1.0
|
||||
Algebraic MultiGrid Preconditioners Package
|
||||
based on PSBLAS (Parallel Sparse BLAS version 3.7)
|
||||
|
||||
(C) Copyright 2021
|
||||
|
||||
Pasqua D'Ambra IAC-CNR, IT
|
||||
Fabio Durastante University of Pisa and IAC-CNR, IT
|
||||
Salvatore Filippone University of Rome Tor-Vergata and IAC-CNR, IT
|
||||
|
||||
Redistribution and use in source and binary forms, with or without
|
||||
modification, are permitted provided that the following conditions
|
||||
are met:
|
||||
1. Redistributions of source code must retain the above copyright
|
||||
notice, this list of conditions and the following disclaimer.
|
||||
2. Redistributions in binary form must reproduce the above copyright
|
||||
notice, this list of conditions, and the following disclaimer in the
|
||||
documentation and/or other materials provided with the distribution.
|
||||
3. The name of the MLD2P4 group or the names of its contributors may
|
||||
not be used to endorse or promote products derived from this
|
||||
software without specific written permission.
|
||||
|
||||
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
|
||||
PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS
|
||||
BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
|
||||
CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
|
||||
SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
|
||||
INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
|
||||
CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
|
||||
ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
|
||||
POSSIBILITY OF SUCH DAMAGE.
|
||||
|
||||
|
||||
AMG4PSBLAS version 1.2
|
||||
Algebraic Multigrid Package
|
||||
based on PSBLAS (Parallel Sparse BLAS version 3.9)
|
||||
|
||||
(C) Copyright 2025
|
||||
|
||||
Salvatore Filippone
|
||||
Pasqua D'Ambra
|
||||
Fabio Durastante
|
||||
|
||||
Redistribution and use in source and binary forms, with or without
|
||||
modification, are permitted provided that the following conditions
|
||||
are met:
|
||||
1. Redistributions of source code must retain the above copyright
|
||||
notice, this list of conditions and the following disclaimer.
|
||||
2. Redistributions in binary form must reproduce the above copyright
|
||||
notice, this list of conditions, and the following disclaimer in the
|
||||
documentation and/or other materials provided with the distribution.
|
||||
3. The name of the AMG4PSBLAS group or the names of its contributors may
|
||||
not be used to endorse or promote products derived from this
|
||||
software without specific written permission.
|
||||
|
||||
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
|
||||
PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AMG4PSBLAS GROUP OR ITS CONTRIBUTORS
|
||||
BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
|
||||
CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
|
||||
SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
|
||||
INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
|
||||
CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
|
||||
ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
|
||||
POSSIBILITY OF SUCH DAMAGE.
|
||||
|
||||
\end{verbatim}
|
||||
}
|
||||
|
||||
+39
-29
@@ -3,7 +3,9 @@
|
||||
{\textsc{\ref{sec:overview} General Overview}}
|
||||
|
||||
The \textsc{Algebraic MultiGrid Preconditioners Package based on
|
||||
PSBLAS} (\textsc{AMG\-4\-PSBLAS}) provides parallel Algebraic MultiGrid (AMG) preconditioners (see, e.g., \cite{Briggs2000,Stuben_01}),
|
||||
PSBLAS} (\textsc{AMG\-4\-PSBLAS}) provides parallel Algebraic
|
||||
MultiGrid (AMG) preconditioners (see, e.g.,
|
||||
\cite{Briggs2000,Stuben_01}),
|
||||
to be used in the iterative solution of linear systems,
|
||||
\begin{equation}
|
||||
Ax=b,
|
||||
@@ -18,12 +20,14 @@ where $A$ is a square, real or complex, sparse symmetric positive definite (s.p.
|
||||
|
||||
The preconditioners implemented in AMG4PSBLAS are obtained by combining
|
||||
3 different types of AMG cycles with smoothers and coarsest-level
|
||||
solvers. Available multigrid cycles include the V-, W-, and a version of a Krylov-type cycle
|
||||
solvers. We provide a number of multigrid cycles, including the V-,
|
||||
W-, and a version of a Krylov-type cycle
|
||||
(K-cycle)~\cite{Briggs2000,Notay2008}; they can be
|
||||
combined with Jacobi, hybrid
|
||||
%\footnote{see Note 2 in Table~\ref{tab:p_coarse}, p.~28.}
|
||||
forward/backward Gauss-Seidel, block-Jacobi and additive Schwarz
|
||||
smoothers with various versions of local incomplete factorizations and approximate inverses
|
||||
smoothers with various versions of local incomplete factorizations and
|
||||
approximate inverses
|
||||
on the blocks. The Jacobi, block-Jacobi and
|
||||
Gauss-Seidel smoothers are also available in the $\ell_1$ version~\cite{DDF2020}.
|
||||
|
||||
@@ -41,7 +45,8 @@ two different coarsening strategies, based on aggregation, are available:
|
||||
and described in detail in~\cite{DDF2020};
|
||||
\end{itemize}
|
||||
Either exact or approximate solvers can be used on the coarsest-level
|
||||
system. We provide interfaces to various parallel and sequential sparse LU factorizations from external
|
||||
system. We provide interfaces to various parallel and sequential
|
||||
sparse LU factorizations from external
|
||||
packages, sequential native incomplete LU and approximate inverse factorizations,
|
||||
parallel weighted Jacobi, hybrid Gauss-Seidel, block-Jacobi solvers and
|
||||
calls to preconditioned Krylov methods; all
|
||||
@@ -74,36 +79,41 @@ important revisions and extentions of the PSBLAS infrastructure.
|
||||
The inter-process comunication required by AMG4PSBLAS is encapsulated
|
||||
in the PSBLAS routines;
|
||||
therefore, AMG4PSBLAS can be run on any parallel machine where PSBLAS
|
||||
implementations are available. In the most recent version of PSBLAS
|
||||
(release 3.7), a plug-in for GPU is included; it includes CUDA
|
||||
implementations are available. The most recent version of PSBLAS
|
||||
(release 3.9) includes a plug-in for GPU; it contains CUDA
|
||||
versions of main vector operations and of sparse matrix-vector
|
||||
multiplication, so that Krylov methods coupled with AMG4PSBLAS
|
||||
preconditioners relying on Jacobi and block-Jacobi smoothers with
|
||||
sparse approximate inverses on the blocks can be efficiently executed
|
||||
preconditioners relying on Jacobi and block-Jacobi smoothers with
|
||||
sparse approximate inverses on the blocks can be efficiently executed
|
||||
on cluster of GPUs.
|
||||
|
||||
AMG4PSBLAS has a layered and modular software architecture where three main layers can be
|
||||
identified. The lower layer consists of the PSBLAS kernels, the middle one implements
|
||||
the construction and application phases of the preconditioners, and the upper one
|
||||
provides a uniform interface to all the preconditioners.
|
||||
This architecture allows for different levels of use of the package:
|
||||
few black-box routines at the upper layer allow all users to easily
|
||||
build and apply any preconditioner available in AMG4PSBLAS;
|
||||
facilities are also available allowing expert users to extend the set of smoothers
|
||||
and solvers for building new versions of the preconditioners (see
|
||||
Section~\ref{sec:adding}).
|
||||
AMG4PSBLAS has a layered and modular software architecture where three
|
||||
main layers can be identified. The lower layer consists of the PSBLAS
|
||||
kernels, the middle one implements the construction and application
|
||||
phases of the preconditioners, and the upper one provides a uniform
|
||||
interface to all the preconditioners. This architecture allows for
|
||||
different levels of use of the package: few black-box routines at the
|
||||
upper layer allow all users to easily build and apply any
|
||||
preconditioner available in AMG4PSBLAS; facilities are also available
|
||||
allowing expert users to extend the set of smoothers and solvers for
|
||||
building new versions of the preconditioners (see
|
||||
Section~\ref{sec:adding}).
|
||||
|
||||
This guide is organized as follows. General information on the distribution of the source
|
||||
code is reported in Section~\ref{sec:distribution}, while details on the configuration
|
||||
and installation of the package are given in Section~\ref{sec:building}. The basics for building and applying the
|
||||
preconditioners with the Krylov solvers implemented in PSBLAS are reported
|
||||
in~Section~\ref{sec:started}, where the Fortran codes of a few sample programs
|
||||
are also shown. A reference guide for the user interface routines is provided
|
||||
in Section~\ref{sec:userinterface}. Information on the extension of the package
|
||||
through the addition of new smoothers and solvers is reported in Section~\ref{sec:adding}.
|
||||
The error handling mechanism used by the package
|
||||
is briefly described in Section~\ref{sec:errors}. The copyright terms concerning the
|
||||
distribution and modification of AMG4PSBLAS are reported in Appendix~\ref{sec:license}.
|
||||
This guide is organized as follows. General information on the
|
||||
distribution of the source code is reported in
|
||||
Section~\ref{sec:distribution}, while details on the configuration and
|
||||
installation of the package are given in
|
||||
Section~\ref{sec:building}. The basics for building and applying the
|
||||
preconditioners with the Krylov solvers implemented in PSBLAS are
|
||||
reported in~Section~\ref{sec:started}, where the Fortran codes of a
|
||||
few sample programs are also shown. A reference guide for the user
|
||||
interface routines is provided in
|
||||
Section~\ref{sec:userinterface}. Information on the extension of the
|
||||
package through the addition of new smoothers and solvers is reported
|
||||
in Section~\ref{sec:adding}. The error handling mechanism used by the
|
||||
package is briefly described in Section~\ref{sec:errors}. The
|
||||
copyright terms concerning the distribution and modification of
|
||||
AMG4PSBLAS are reported in Appendix~\ref{sec:license}.
|
||||
|
||||
%%% Local Variables:
|
||||
%%% mode: latex
|
||||
|
||||
@@ -154,7 +154,7 @@ Preconditioners Package based on PSBLAS}
|
||||
\flushright
|
||||
\large Software version: 1.2\\
|
||||
%\todaym
|
||||
\large June 9th, 2025
|
||||
\large December 23rd, 2025
|
||||
\end{minipage}}
|
||||
%\addtolength{\textwidth}{\centeroffset}
|
||||
\vspace{\stretch{2}}
|
||||
|
||||
@@ -114,7 +114,7 @@
|
||||
%\today
|
||||
Software version: 1.2\\
|
||||
%\today
|
||||
June 9th, 2025
|
||||
December 23rd, 2025
|
||||
\clearpage
|
||||
\ \\
|
||||
\thispagestyle{empty}
|
||||
|
||||
+53
-43
@@ -160,7 +160,7 @@ the smoothers. However, for simplicity, shortcuts are
|
||||
provided to set all versions of point-Jacobi, hybrid (forward) Gauss-Seidel, and
|
||||
hybrid backward Gauss-Seidel, i.e., the previous smoothers can be defined
|
||||
just by setting \fortinline|'SMOOTHER_TYPE'| to certain specific
|
||||
values (see Tables~\ref{tab:p_smoother}), without the need to set
|
||||
values (see Table~\ref{tab:p_smoother}), without the need to set
|
||||
\fortinline|'SUB_SOLVE'| as well.
|
||||
|
||||
The smoother and solver objects are arranged in a
|
||||
@@ -182,47 +182,50 @@ the polynomial used. Consequently, the \fortinline|'SMOOTHER_SWEEPS'| option is
|
||||
the \fortinline|'POLY_DEGREE'| option. This smoother is paired with a base smoother
|
||||
object, whose iterations are accelerated using the specified polynomial smoothing technique.
|
||||
By default, the $\ell_1$-Jacobi smoother serves as the base smoother, offering theoretical
|
||||
guarantees on the resulting convergence factor~\cite{DDFMT2024,LOTTES}. Alternative combinations
|
||||
are experimental and lack established guarantees.\\
|
||||
guarantees on the resulting convergence
|
||||
factor~\cite{DDFMT2024,LOTTES}. Alternative combinations are
|
||||
experimental.\\
|
||||
% and lack established guarantees.\\
|
||||
|
||||
\textbf{Remark 4.} Many of the coarsest-level solvers apply to a
|
||||
specific coarsest-matrix layout;
|
||||
therefore, setting the solver after the layout may change the layout
|
||||
to either distributed or replicated.
|
||||
Similarly, setting the layout after the solver may change the solver.
|
||||
|
||||
More precisely, UMFPACK and SuperLU require the coarsest-level
|
||||
matrix to be replicated, while SuperLU\_Dist and KRM require it to be distributed.
|
||||
In these cases, setting the coarsest-level solver implies that
|
||||
the layout is redefined according to the solver, ovverriding any
|
||||
specific coarsest-matrix layout; therefore, setting the solver after
|
||||
the layout may change the layout to either distributed or replicated,
|
||||
and similarly, setting the layout after the solver may change the
|
||||
solver. More specifically, UMFPACK and SuperLU require the coarsest-level
|
||||
matrix to be replicated, while SuperLU\_Dist and KRM require it to be
|
||||
distributed; therefore, setting the coarsest-level solver implies
|
||||
that the layout is redefined according to the solver, ovverriding any
|
||||
previous settings. MUMPS, point-Jacobi,
|
||||
hybrid Gauss-Seidel and block-Jacobi can be applied to
|
||||
replicated and distributed matrices, thus their choice
|
||||
does not modify any previously specified layout.
|
||||
It is worth noting that, when the matrix is replicated,
|
||||
the point-Jacobi, hybrid Gauss-Seidel and block-Jacobi solvers and their $\ell_1-$ versions
|
||||
reduce to the corresponding local solver objects (see Remark~2).
|
||||
For the point-Jacobi and Gauss-Seidel solvers, these objects
|
||||
correspond to a \emph{single} point-Jacobi sweep and a \emph{single}
|
||||
Gauss-Seidel sweep, respectively, which are very poor solvers.
|
||||
the point-Jacobi, hybrid Gauss-Seidel and block-Jacobi solvers and
|
||||
their $\ell_1-$ versions reduce to the corresponding local solver
|
||||
objects (see Remark~2). For the point-Jacobi and Gauss-Seidel solvers,
|
||||
these objects correspond to a \emph{single} point-Jacobi sweep and a
|
||||
\emph{single} Gauss-Seidel sweep, respectively, which are very poor
|
||||
solvers.
|
||||
|
||||
On the other hand, the distributed layout can be used with any solver
|
||||
but UMFPACK and SuperLU; therefore, if any of these two solvers has already
|
||||
been selected, the coarsest-level solver is changed to block-Jacobi,
|
||||
with the previously chosen solver applied to the local blocks.
|
||||
Likewise, the replicated layout can be used with any solver but SuperLu\_Dist and KRM;
|
||||
therefore, if SuperLu\_Dist or KRM have been previously set, the coarsest-level
|
||||
solver is changed to the default sequential solver.
|
||||
On the other hand, the distributed layout can be used with any solver
|
||||
except and SuperLU; therefore, if any of these two solvers has
|
||||
already been selected, the coarsest-level solver is changed to
|
||||
block-Jacobi, with the previously chosen solver applied to the local
|
||||
blocks. Likewise, the replicated layout can be used with any solver
|
||||
but SuperLu\_Dist and KRM; therefore, if SuperLu\_Dist or KRM have
|
||||
been previously set, the coarsest-level solver is changed to the
|
||||
default sequential solver.
|
||||
|
||||
In a parallel setting with many cores, we suggest to the users to change the default
|
||||
coarsest solver for using the KRM choice, i.e. a parallel distributed iterative solution of the
|
||||
coarsest system based on Krylov methods.
|
||||
In a parallel setting with many cores, we suggest to the users to
|
||||
change the default coarsest solver for using the KRM choice, i.e. a
|
||||
parallel distributed iterative solution of the coarsest system based
|
||||
on Krylov methods.
|
||||
|
||||
\textbf{Remark 4.} The argument \fortinline|idx| can be used to allow finer
|
||||
control for those solvers; for instance, by specifying the keyword
|
||||
\fortinline|'MUMPS_IPAR_ENTRY'| and an appropriate value for \fortinline|idx|, it is
|
||||
possible to set any entry in the MUMPS integer control array.
|
||||
See also Sec.~\ref{sec:adding}.
|
||||
\textbf{Remark 4.} The argument \fortinline|idx| can be used to allow
|
||||
finer control for those solvers; for instance, by specifying the
|
||||
keyword \fortinline|'MUMPS_IPAR_ENTRY'| and an appropriate value for
|
||||
\fortinline|idx|, it is possible to set any entry in the MUMPS integer
|
||||
control array. See also Sec.~\ref{sec:adding}.
|
||||
%The \verb|what,val| pairs described here are those of the predefined
|
||||
%moother/solver objects; newly developed solvers may define new pairs
|
||||
%according to their needs.
|
||||
@@ -253,7 +256,7 @@ be applied.
|
||||
\bsideways
|
||||
\begin{center}
|
||||
%\begin{tabular}{|p{5cm}|l|p{2.4cm}|p{2.5cm}|p{5cm}|}
|
||||
\begin{tabular}{|p{5.7cm}|l|p{2.3cm}|p{2.5cm}|p{6.9cm}|}
|
||||
\begin{tabular}{|p{5.7cm}|l|p{2.3cm}|p{2.0cm}|p{6.4cm}|}
|
||||
\hline
|
||||
\fortinline|what| & \textsc{data type} & \fortinline|val| & \textsc{default} &
|
||||
\textsc{comments} \\ \hline
|
||||
@@ -292,8 +295,8 @@ be applied.
|
||||
& Maximum number of levels. The aggregation stops
|
||||
if the number of levels reaches this value (see Note). \\ \hline
|
||||
\fortinline|'PAR_AGGR_ALG'| & \fortinline|character(len=*)| \hspace*{-3mm}
|
||||
& \texttt{'DEC'}, \texttt{'SYMDEC'}, \texttt{'COUPLED'}
|
||||
& \texttt{'DEC'}
|
||||
& \texttt{'DECOUPLED'}, \texttt{'SYMDEC'}, \texttt{'COUPLED'}
|
||||
& \texttt{'DECOUPLED'}
|
||||
& Parallel aggregation algorithm. \par the
|
||||
\fortinline|SYMDEC| option applies decoupled
|
||||
aggregation to the sparsity pattern
|
||||
@@ -445,13 +448,20 @@ the parameter \texttt{ilev}.} \\
|
||||
\bsideways
|
||||
\ContinuedFloat
|
||||
\begin{center}
|
||||
\begin{tabular}{|p{3.9cm}|l|p{1.7cm}|p{1.7cm}|p{8.6cm}|}
|
||||
\begin{tabular}{|p{3.6cm}|l|p{1.7cm}|p{1.7cm}|p{8.2cm}|}
|
||||
\hline
|
||||
\fi
|
||||
\fortinline|'COARSE_SUBSOLVE'| & \fortinline|character(len=*)|
|
||||
& \fortinline|'ILU'| \par \fortinline|'ILUT'| \par \fortinline|'MILU'| \par
|
||||
\fortinline|'MUMPS'| \par \fortinline|'SLU'| \par \fortinline|'UMF'| \par
|
||||
\fortinline|'INVT'| \par \fortinline|'INVK'| \par \fortinline|'AINV'|
|
||||
& \fortinline|'ILU'| \par
|
||||
\fortinline|'ILUT'| \par
|
||||
\fortinline|'MILU'| \par
|
||||
\fortinline|'MUMPS'| \par
|
||||
\fortinline|'SLU'| \par
|
||||
\fortinline|'SLUDIST'| \par
|
||||
\fortinline|'UMF'| \par
|
||||
\fortinline|'INVT'| \par
|
||||
\fortinline|'INVK'| \par
|
||||
\fortinline|'AINV'|
|
||||
& See~Note.
|
||||
& Solver for the diagonal blocks of the coarsest matrix,
|
||||
in case the block Jacobi solver
|
||||
@@ -487,18 +497,18 @@ the parameter \texttt{ilev}.} \\
|
||||
\fortinline|what| & \textsc{data type} & \fortinline|val| & \textsc{default} &
|
||||
\textsc{comments} \\ \hline
|
||||
\fortinline|'COARSE_SWEEPS'| & \fortinline|integer|
|
||||
& Any integer \par number $> 0$
|
||||
& Any integer number $> 0$
|
||||
& 10
|
||||
& Number of sweeps when \fortinline|JACOBI|, \fortinline|GS| or \fortinline|BJAC|
|
||||
is chosen as coarsest-level solver.\\ \hline
|
||||
\fortinline|'COARSE_FILLIN'| & \fortinline|integer|
|
||||
& Any integer \par number $\ge 0$
|
||||
& Any integer number $\ge 0$
|
||||
& 0
|
||||
& Fill-in level $p$ of the ILU factorizations
|
||||
and first fill-in for the approximate inverses. \\ \hline
|
||||
\fortinline|'COARSE_ILUTHRS'|
|
||||
& \fortinline|real(kind_parameter)|
|
||||
& Any real \par number $\ge 0$
|
||||
& Any real number $\ge 0$
|
||||
& 0
|
||||
& Drop tolerance $t$ in the ILU($p,t$)
|
||||
factorization and first drop-tolerance for the approximate inverses. \\
|
||||
@@ -542,7 +552,7 @@ level (continued).\label{tab:p_coarse_1}}
|
||||
\bsideways
|
||||
\ContinuedFloat
|
||||
\begin{center}
|
||||
\begin{tabular}{|p{3.9cm}|l|p{1.7cm}|p{1.7cm}|p{8.6cm}|}
|
||||
\begin{tabular}{|p{3.5cm}|l|p{1.7cm}|p{1.4cm}|p{8.6cm}|}
|
||||
\hline
|
||||
\fi
|
||||
\fortinline|'KRM_SUB_SOLVE'| & \fortinline|character(len=*)| & Table~\ref{tab:p_coarse_1} & \fortinline|'ILU'| & Solver for the diagonal blocks of the coarsest matrix preconditioner,
|
||||
|
||||
@@ -0,0 +1,117 @@
|
||||
cmake_minimum_required(VERSION 3.15)
|
||||
project(AMGExamples Fortran)
|
||||
|
||||
# Installation directories (passed as CMake variables)
|
||||
set(AMG4PSBLAS_INSTALL_DIR "" CACHE PATH "Path to AMG installation")
|
||||
set(PSBLAS_INSTALL_DIR "" CACHE PATH "Path to PSBLAS installation")
|
||||
|
||||
# Check if installation directories are set
|
||||
if(NOT AMG4PSBLAS_INSTALL_DIR)
|
||||
message(FATAL_ERROR "AMG_INSTALL_DIR must be set. Use -DAMG_INSTALL_DIR=/path/to/amg when running CMake.")
|
||||
endif()
|
||||
|
||||
if(NOT PSBLAS_INSTALL_DIR)
|
||||
message(FATAL_ERROR "PSBLAS_INSTALL_DIR must be set. Use -DPSBLAS_INSTALL_DIR=/path/to/psblas when running CMake.")
|
||||
endif()
|
||||
|
||||
|
||||
find_package(psblas REQUIRED PATHS ${PSBLAS_INSTALL_DIR})
|
||||
find_package(amg4psblas REQUIRED PATHS ${AMG4PSBLAS_INSTALL_DIR})
|
||||
|
||||
|
||||
# Include directories
|
||||
include_directories(
|
||||
"."
|
||||
"${AMG4PSBLAS_INSTALL_DIR}/include"
|
||||
"${AMG4PSBLAS_INSTALL_DIR}/modules"
|
||||
"${PSBLAS_INSTALL_DIR}/include"
|
||||
)
|
||||
|
||||
# Fortran module directory
|
||||
set(CMAKE_Fortran_MODULE_DIRECTORY "${CMAKE_CURRENT_BINARY_DIR}/modules")
|
||||
set(FMFLAG "-I")
|
||||
|
||||
# Library directories
|
||||
link_directories(
|
||||
"${AMG4PSBLAS_INSTALL_DIR}/lib"
|
||||
"${PSBLAS_INSTALL_DIR}/lib"
|
||||
)
|
||||
|
||||
# Libraries
|
||||
set(AMG_LIBS amg4psblas::amgprec)
|
||||
set(PSBLAS_LIBS psblas::util psblas::linsolve psblas::prec psblas::base)
|
||||
|
||||
# Executable directory
|
||||
set(EXEDIR "${CMAKE_CURRENT_BINARY_DIR}/runs")
|
||||
file(MAKE_DIRECTORY "${EXEDIR}")
|
||||
|
||||
set(COMMON_SOURCE data_input.f90)
|
||||
|
||||
# Source files
|
||||
set(DFSOBJS ${COMMON_SOURCE} amg_df_sample.f90)
|
||||
set(SFSOBJS ${COMMON_SOURCE} amg_sf_sample.f90)
|
||||
set(CFSOBJS ${COMMON_SOURCE} amg_cf_sample.f90)
|
||||
set(ZFSOBJS ${COMMON_SOURCE} amg_zf_sample.f90)
|
||||
|
||||
|
||||
|
||||
# Function to create executable
|
||||
macro(create_amg_executable target sources)
|
||||
add_executable(${target} ${sources})
|
||||
target_link_libraries(${target} PUBLIC
|
||||
${AMG_LIBS}
|
||||
${PSBLAS_LIBS}
|
||||
|
||||
)
|
||||
|
||||
# Move executable to EXEDIR (post-build)
|
||||
#add_custom_command(TARGET ${target} POST_BUILD
|
||||
# COMMAND ${CMAKE_COMMAND} -E move $<TARGET_FILE:${target}> ${EXEDIR}
|
||||
#)
|
||||
set_target_properties(${target} PROPERTIES
|
||||
RUNTIME_OUTPUT_DIRECTORY ${EXEDIR}
|
||||
)
|
||||
endmacro()
|
||||
|
||||
|
||||
# Create executables
|
||||
create_amg_executable(amg_df_sample "${DFSOBJS}")
|
||||
create_amg_executable(amg_sf_sample "${SFSOBJS}")
|
||||
create_amg_executable(amg_cf_sample "${CFSOBJS}")
|
||||
create_amg_executable(amg_zf_sample "${ZFSOBJS}")
|
||||
|
||||
# Create "runs" directory (if it doesn't exist)
|
||||
add_custom_target(create_runs_dir
|
||||
COMMAND ${CMAKE_COMMAND} -E make_directory "${EXEDIR}"
|
||||
WORKING_DIRECTORY ${CMAKE_CURRENT_SOURCE_DIR}
|
||||
COMMENT "Creating runs directory"
|
||||
)
|
||||
add_dependencies(amg_df_sample create_runs_dir)
|
||||
add_dependencies(amg_sf_sample create_runs_dir)
|
||||
add_dependencies(amg_cf_sample create_runs_dir)
|
||||
add_dependencies(amg_zf_sample create_runs_dir)
|
||||
|
||||
|
||||
|
||||
# lib target
|
||||
add_custom_target(lib
|
||||
COMMAND ${CMAKE_COMMAND} -E chdir "../../" ${CMAKE_COMMAND} --build . --target library
|
||||
WORKING_DIRECTORY ${CMAKE_CURRENT_SOURCE_DIR}
|
||||
COMMENT "Building library"
|
||||
)
|
||||
|
||||
# verycleanlib target
|
||||
add_custom_target(verycleanlib
|
||||
COMMAND ${CMAKE_COMMAND} -E chdir "../../" ${CMAKE_COMMAND} --build . --target veryclean
|
||||
WORKING_DIRECTORY ${CMAKE_CURRENT_SOURCE_DIR}
|
||||
COMMENT "Cleaning library"
|
||||
)
|
||||
|
||||
# Install target (optional)
|
||||
install(TARGETS
|
||||
amg_sf_sample
|
||||
amg_df_sample
|
||||
amg_cf_sample
|
||||
amg_zf_sample
|
||||
DESTINATION bin
|
||||
)
|
||||
@@ -659,7 +659,9 @@ contains
|
||||
write(psb_err_unit,*) 'Opened file ',trim(filename),' for input'
|
||||
end if
|
||||
else
|
||||
inp_unit=psb_inp_unit
|
||||
write(psb_err_unit,*) 'Usage: amg_cf_sample ctrl-file '
|
||||
call psb_abort(ctxt)
|
||||
stop
|
||||
end if
|
||||
!
|
||||
! input files
|
||||
|
||||
@@ -659,7 +659,9 @@ contains
|
||||
write(psb_err_unit,*) 'Opened file ',trim(filename),' for input'
|
||||
end if
|
||||
else
|
||||
inp_unit=psb_inp_unit
|
||||
write(psb_err_unit,*) 'Usage: amg_df_sample ctrl-file '
|
||||
call psb_abort(ctxt)
|
||||
stop
|
||||
end if
|
||||
!
|
||||
! input files
|
||||
|
||||
@@ -659,7 +659,9 @@ contains
|
||||
write(psb_err_unit,*) 'Opened file ',trim(filename),' for input'
|
||||
end if
|
||||
else
|
||||
inp_unit=psb_inp_unit
|
||||
write(psb_err_unit,*) 'Usage: amg_sf_sample ctrl-file '
|
||||
call psb_abort(ctxt)
|
||||
stop
|
||||
end if
|
||||
!
|
||||
! input files
|
||||
|
||||
@@ -659,7 +659,9 @@ contains
|
||||
write(psb_err_unit,*) 'Opened file ',trim(filename),' for input'
|
||||
end if
|
||||
else
|
||||
inp_unit=psb_inp_unit
|
||||
write(psb_err_unit,*) 'Usage: amg_zf_sample ctrl-file '
|
||||
call psb_abort(ctxt)
|
||||
stop
|
||||
end if
|
||||
!
|
||||
! input files
|
||||
|
||||
@@ -0,0 +1,229 @@
|
||||
cmake_minimum_required(VERSION 3.15)
|
||||
project(AMGExamples Fortran CXX)
|
||||
|
||||
# Installation directories (passed as CMake variables)
|
||||
set(AMG4PSBLAS_INSTALL_DIR "" CACHE PATH "Path to AMG installation")
|
||||
set(PSBLAS_INSTALL_DIR "" CACHE PATH "Path to PSBLAS installation")
|
||||
|
||||
# Check if installation directories are set
|
||||
if(NOT AMG4PSBLAS_INSTALL_DIR)
|
||||
message(FATAL_ERROR "AMG_INSTALL_DIR must be set. Use -DAMG_INSTALL_DIR=/path/to/amg when running CMake.")
|
||||
endif()
|
||||
|
||||
if(NOT PSBLAS_INSTALL_DIR)
|
||||
message(FATAL_ERROR "PSBLAS_INSTALL_DIR must be set. Use -DPSBLAS_INSTALL_DIR=/path/to/psblas when running CMake.")
|
||||
endif()
|
||||
|
||||
|
||||
find_package(psblas REQUIRED PATHS ${PSBLAS_INSTALL_DIR})
|
||||
find_package(amg4psblas REQUIRED PATHS ${AMG4PSBLAS_INSTALL_DIR})
|
||||
|
||||
|
||||
|
||||
find_package(MPI REQUIRED Fortran CXX )
|
||||
|
||||
if(MPI_FOUND)
|
||||
|
||||
|
||||
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 compiler
|
||||
#----------------
|
||||
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)
|
||||
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")
|
||||
message(STATUS "Fortran debug flags added: -g")
|
||||
endif()
|
||||
|
||||
# Include directories
|
||||
include_directories(
|
||||
"."
|
||||
"${AMG4PSBLAS_INSTALL_DIR}/include"
|
||||
"${AMG4PSBLAS_INSTALL_DIR}/modules"
|
||||
"${PSBLAS_INSTALL_DIR}/include"
|
||||
"${PSBLAS_INSTALL_DIR}/modules"
|
||||
)
|
||||
|
||||
# Fortran module directory
|
||||
set(CMAKE_Fortran_MODULE_DIRECTORY "${CMAKE_CURRENT_BINARY_DIR}/modules")
|
||||
set(FMFLAG "-I")
|
||||
|
||||
# Library directories
|
||||
link_directories(
|
||||
"${AMG4PSBLAS_INSTALL_DIR}/lib"
|
||||
"${PSBLAS_INSTALL_DIR}/lib"
|
||||
)
|
||||
|
||||
# Libraries
|
||||
set(AMG_LIBS amg4psblas::amgprec)
|
||||
set(PSBLAS_LIBS psblas::util psblas::linsolve psblas::prec psblas::base)
|
||||
|
||||
# Executable directory
|
||||
set(EXEDIR "${CMAKE_CURRENT_BINARY_DIR}/runs")
|
||||
file(MAKE_DIRECTORY "${EXEDIR}")
|
||||
|
||||
set(COMMON_SOURCE data_input.f90)
|
||||
|
||||
# Source files
|
||||
set(DFSOBJS ${COMMON_SOURCE} amg_df_sample.f90)
|
||||
set(SFSOBJS ${COMMON_SOURCE} amg_sf_sample.f90)
|
||||
set(CFSOBJS ${COMMON_SOURCE} amg_cf_sample.f90)
|
||||
set(ZFSOBJS ${COMMON_SOURCE} amg_zf_sample.f90)
|
||||
|
||||
|
||||
# Source files
|
||||
set(DGEN2D
|
||||
amg_d_pde2d_poisson_mod.f90
|
||||
amg_d_pde2d_exp_mod.f90
|
||||
amg_d_pde2d_gauss_mod.f90
|
||||
amg_d_pde2d_box_mod.f90
|
||||
)
|
||||
set(DGEN3D
|
||||
amg_d_pde3d_poisson_mod.f90
|
||||
amg_d_pde3d_exp_mod.f90
|
||||
amg_d_pde3d_gauss_mod.f90
|
||||
amg_d_pde3d_box_mod.f90
|
||||
)
|
||||
set(SGEN2D
|
||||
amg_s_pde2d_poisson_mod.f90
|
||||
amg_s_pde2d_exp_mod.f90
|
||||
amg_s_pde2d_gauss_mod.f90
|
||||
amg_s_pde2d_box_mod.f90
|
||||
)
|
||||
set(SGEN3D
|
||||
amg_s_pde3d_poisson_mod.f90
|
||||
amg_s_pde3d_exp_mod.f90
|
||||
amg_s_pde3d_gauss_mod.f90
|
||||
amg_s_pde3d_box_mod.f90
|
||||
)
|
||||
|
||||
# Define executables and their sources
|
||||
set(amg_d_pde3d_SOURCES
|
||||
${COMMON_SOURCE}
|
||||
amg_d_pde3d.F90
|
||||
amg_d_genpde_mod.F90
|
||||
${DGEN3D}
|
||||
)
|
||||
set(amg_s_pde3d_SOURCES
|
||||
${COMMON_SOURCE}
|
||||
amg_s_pde3d.F90
|
||||
amg_s_genpde_mod.F90
|
||||
${SGEN3D}
|
||||
)
|
||||
set(amg_d_pde2d_SOURCES
|
||||
${COMMON_SOURCE}
|
||||
amg_d_pde2d.F90
|
||||
amg_d_genpde_mod.F90
|
||||
${DGEN2D}
|
||||
)
|
||||
set(amg_s_pde2d_SOURCES
|
||||
${COMMON_SOURCE}
|
||||
amg_s_pde2d.F90
|
||||
amg_s_genpde_mod.F90
|
||||
${SGEN2D}
|
||||
)
|
||||
|
||||
|
||||
|
||||
|
||||
# Function to create executable
|
||||
function(create_amg_executable target sources)
|
||||
add_executable(${target} ${sources})
|
||||
target_link_libraries(${target} PUBLIC
|
||||
${AMG_LIBS}
|
||||
${PSBLAS_LIBS}
|
||||
${MPI_LIBRARIES}
|
||||
)
|
||||
|
||||
# Move executable to EXEDIR (post-build)
|
||||
#add_custom_command(TARGET ${target} POST_BUILD
|
||||
# COMMAND ${CMAKE_COMMAND} -E move $<TARGET_FILE:${target}> ${EXEDIR}
|
||||
#)
|
||||
set_target_properties(${target} PROPERTIES
|
||||
RUNTIME_OUTPUT_DIRECTORY ${EXEDIR}
|
||||
LINKER_LANGUAGE Fortran
|
||||
)
|
||||
endfunction()
|
||||
|
||||
|
||||
# Create executables
|
||||
create_amg_executable(amg_d_pde3d "${amg_d_pde3d_SOURCES}")
|
||||
create_amg_executable(amg_s_pde3d "${amg_s_pde3d_SOURCES}")
|
||||
create_amg_executable(amg_d_pde2d "${amg_d_pde2d_SOURCES}")
|
||||
create_amg_executable(amg_s_pde2d "${amg_s_pde2d_SOURCES}")
|
||||
|
||||
# Create "runs" directory (if it doesn't exist)
|
||||
add_custom_target(create_runs_dir
|
||||
COMMAND ${CMAKE_COMMAND} -E make_directory "${EXEDIR}"
|
||||
WORKING_DIRECTORY ${CMAKE_CURRENT_SOURCE_DIR}
|
||||
COMMENT "Creating runs directory"
|
||||
)
|
||||
add_dependencies(amg_d_pde3d create_runs_dir)
|
||||
add_dependencies(amg_s_pde3d create_runs_dir)
|
||||
add_dependencies(amg_d_pde2d create_runs_dir)
|
||||
add_dependencies(amg_s_pde2d create_runs_dir)
|
||||
|
||||
|
||||
# lib target
|
||||
add_custom_target(lib
|
||||
COMMAND ${CMAKE_COMMAND} -E chdir "../../" ${CMAKE_COMMAND} --build . --target library
|
||||
WORKING_DIRECTORY ${CMAKE_CURRENT_SOURCE_DIR}
|
||||
COMMENT "Building library"
|
||||
)
|
||||
|
||||
# verycleanlib target
|
||||
add_custom_target(verycleanlib
|
||||
COMMAND ${CMAKE_COMMAND} -E chdir "../../" ${CMAKE_COMMAND} --build . --target veryclean
|
||||
WORKING_DIRECTORY ${CMAKE_CURRENT_SOURCE_DIR}
|
||||
COMMENT "Cleaning library"
|
||||
)
|
||||
|
||||
# Check target (simulated)
|
||||
add_custom_target(check
|
||||
COMMAND ${CMAKE_COMMAND} -E chdir "${EXEDIR}" "${EXEDIR}/amg_d_pde2d" < "amg_pde2d.inp"
|
||||
COMMAND ${CMAKE_COMMAND} -E chdir "${EXEDIR}" "${EXEDIR}/amg_s_pde2d" < "amg_pde2d.inp"
|
||||
WORKING_DIRECTORY ${CMAKE_CURRENT_SOURCE_DIR}
|
||||
DEPENDS amg_d_pde2d amg_s_pde2d
|
||||
COMMENT "Running check"
|
||||
)
|
||||
|
||||
# Install target (optional)
|
||||
install(TARGETS
|
||||
amg_d_pde3d
|
||||
amg_s_pde3d
|
||||
amg_d_pde2d
|
||||
amg_s_pde2d
|
||||
DESTINATION bin
|
||||
)
|
||||
@@ -21,7 +21,7 @@ all: amg_s_pde3d amg_d_pde3d amg_s_pde2d amg_d_pde2d
|
||||
|
||||
amg_d_pde3d: amg_d_pde3d.o amg_d_genpde_mod.o $(DGEN3D) data_input.o
|
||||
$(FLINK) $(LINKOPT) amg_d_pde3d.o amg_d_genpde_mod.o $(DGEN3D) data_input.o \
|
||||
-o amg_d_pde3d $(AMG_LIBS) $(PSBLAS_LIBS) $(LDLIBS)
|
||||
-o amg_d_pde3d $(AMG_LIBS) $(PSBLAS_LIBS) $(AMG_LDLIBS) $(LDLIBS)
|
||||
/bin/mv amg_d_pde3d $(EXEDIR)
|
||||
|
||||
amg_s_pde3d: amg_s_pde3d.o amg_s_genpde_mod.o $(SGEN3D) data_input.o
|
||||
|
||||
@@ -266,8 +266,9 @@ contains
|
||||
npdims = 0
|
||||
#if defined(PSB_SERIAL_MPI)
|
||||
npdims = 1
|
||||
#else
|
||||
call mpi_dims_create(np,3,npdims,info)
|
||||
#else
|
||||
npp = np
|
||||
call mpi_dims_create(npp,3,npdims,minfo)
|
||||
#endif
|
||||
npx = npdims(1)
|
||||
npy = npdims(2)
|
||||
@@ -734,7 +735,8 @@ contains
|
||||
#if defined(PSB_SERIAL_MPI)
|
||||
npdims = 1
|
||||
#else
|
||||
call mpi_dims_create(np,2,npdims,info)
|
||||
npp = np
|
||||
call mpi_dims_create(npp,2,npdims,minfo)
|
||||
#endif
|
||||
npx = npdims(1)
|
||||
npy = npdims(2)
|
||||
|
||||
@@ -634,7 +634,9 @@ contains
|
||||
write(psb_err_unit,*) 'Opened file ',trim(filename),' for input'
|
||||
end if
|
||||
else
|
||||
inp_unit=psb_inp_unit
|
||||
write(psb_err_unit,*) 'Usage: amg_d_pde2d ctrl-file '
|
||||
call psb_abort(ctxt)
|
||||
stop
|
||||
end if
|
||||
! read input data
|
||||
!
|
||||
|
||||
@@ -638,7 +638,9 @@ contains
|
||||
write(psb_err_unit,*) 'Opened file ',trim(filename),' for input'
|
||||
end if
|
||||
else
|
||||
inp_unit=psb_inp_unit
|
||||
write(psb_err_unit,*) 'Usage: amg_d_pde3d ctrl-file '
|
||||
call psb_abort(ctxt)
|
||||
stop
|
||||
end if
|
||||
! read input data
|
||||
!
|
||||
|
||||
@@ -266,8 +266,9 @@ contains
|
||||
npdims = 0
|
||||
#if defined(PSB_SERIAL_MPI)
|
||||
npdims = 1
|
||||
#else
|
||||
call mpi_dims_create(np,3,npdims,info)
|
||||
#else
|
||||
npp = np
|
||||
call mpi_dims_create(npp,3,npdims,minfo)
|
||||
#endif
|
||||
npx = npdims(1)
|
||||
npy = npdims(2)
|
||||
@@ -734,7 +735,8 @@ contains
|
||||
#if defined(PSB_SERIAL_MPI)
|
||||
npdims = 1
|
||||
#else
|
||||
call mpi_dims_create(np,2,npdims,info)
|
||||
npp = np
|
||||
call mpi_dims_create(npp,2,npdims,minfo)
|
||||
#endif
|
||||
npx = npdims(1)
|
||||
npy = npdims(2)
|
||||
|
||||
@@ -634,7 +634,9 @@ contains
|
||||
write(psb_err_unit,*) 'Opened file ',trim(filename),' for input'
|
||||
end if
|
||||
else
|
||||
inp_unit=psb_inp_unit
|
||||
write(psb_err_unit,*) 'Usage: amg_s_pde2d ctrl-file '
|
||||
call psb_abort(ctxt)
|
||||
stop
|
||||
end if
|
||||
! read input data
|
||||
!
|
||||
|
||||
@@ -638,7 +638,9 @@ contains
|
||||
write(psb_err_unit,*) 'Opened file ',trim(filename),' for input'
|
||||
end if
|
||||
else
|
||||
inp_unit=psb_inp_unit
|
||||
write(psb_err_unit,*) 'Usage: amg_s_pde3d ctrl-file '
|
||||
call psb_abort(ctxt)
|
||||
stop
|
||||
end if
|
||||
! read input data
|
||||
!
|
||||
|
||||
@@ -58,8 +58,8 @@ VCYCLE ! Type of multilevel CYCLE: VCYCLE WCYCLE KCYCLE MUL
|
||||
-3 ! Max Number of levels in a multilevel preconditioner; if <0, lib default
|
||||
-3 ! Target coarse matrix size per process; if <0, lib default
|
||||
SMOOTHED ! Type of aggregation: SMOOTHED UNSMOOTHED
|
||||
COUPLED ! Parallel aggregation: DEC, SYMDEC, COUPLED
|
||||
MATCHBOXP ! aggregation measure SOC1, MATCHBOXP
|
||||
DEC !COUPLED ! Parallel aggregation: DEC, SYMDEC, COUPLED
|
||||
SOC1 !MATCHBOXP ! aggregation measure SOC1, MATCHBOXP
|
||||
8 ! Requested size of the aggregates for MATCHBOXP
|
||||
NATURAL ! Ordering of aggregation NATURAL DEGREE
|
||||
-1.5 ! Coarsening ratio, if < 0 use library default
|
||||
|
||||
@@ -0,0 +1,129 @@
|
||||
cmake_minimum_required(VERSION 3.15)
|
||||
project(AMGExamples Fortran)
|
||||
|
||||
# Installation directories (passed as CMake variables)
|
||||
set(AMG4PSBLAS_INSTALL_DIR "" CACHE PATH "Path to AMG installation")
|
||||
set(PSBLAS_INSTALL_DIR "" CACHE PATH "Path to PSBLAS installation")
|
||||
|
||||
# Check if installation directories are set
|
||||
if(NOT AMG4PSBLAS_INSTALL_DIR)
|
||||
message(FATAL_ERROR "AMG_INSTALL_DIR must be set. Use -DAMG_INSTALL_DIR=/path/to/amg when running CMake.")
|
||||
endif()
|
||||
|
||||
if(NOT PSBLAS_INSTALL_DIR)
|
||||
message(FATAL_ERROR "PSBLAS_INSTALL_DIR must be set. Use -DPSBLAS_INSTALL_DIR=/path/to/psblas when running CMake.")
|
||||
endif()
|
||||
|
||||
|
||||
find_package(psblas REQUIRED PATHS ${PSBLAS_INSTALL_DIR})
|
||||
find_package(amg4psblas REQUIRED PATHS ${AMG4PSBLAS_INSTALL_DIR})
|
||||
|
||||
|
||||
# Include directories
|
||||
include_directories(
|
||||
"."
|
||||
"${AMG4PSBLAS_INSTALL_DIR}/include"
|
||||
"${AMG4PSBLAS_INSTALL_DIR}/modules"
|
||||
"${PSBLAS_INSTALL_DIR}/include"
|
||||
)
|
||||
|
||||
# Fortran module directory
|
||||
set(CMAKE_Fortran_MODULE_DIRECTORY "${CMAKE_CURRENT_BINARY_DIR}/modules")
|
||||
set(FMFLAG "-I")
|
||||
|
||||
# Library directories
|
||||
link_directories(
|
||||
"${AMG4PSBLAS_INSTALL_DIR}/lib"
|
||||
"${PSBLAS_INSTALL_DIR}/lib"
|
||||
)
|
||||
|
||||
# Libraries
|
||||
set(AMG_LIBS amg4psblas::amgprec)
|
||||
set(PSBLAS_LIBS psblas::util psblas::linsolve psblas::prec psblas::base)
|
||||
|
||||
# Executable directory
|
||||
set(EXEDIR "${CMAKE_CURRENT_BINARY_DIR}/runs")
|
||||
file(MAKE_DIRECTORY "${EXEDIR}")
|
||||
|
||||
set(COMMON_SOURCE data_input.f90)
|
||||
|
||||
# Source files
|
||||
set(DMOBJS ${COMMON_SOURCE} amg_dexample_ml.f90)
|
||||
set(D1OBJS ${COMMON_SOURCE} amg_dexample_1lev.f90)
|
||||
set(ZMOBJS ${COMMON_SOURCE} amg_zexample_ml.f90)
|
||||
set(Z1OBJS ${COMMON_SOURCE} amg_zexample_1lev.f90)
|
||||
set(SMOBJS ${COMMON_SOURCE} amg_sexample_ml.f90)
|
||||
set(S1OBJS ${COMMON_SOURCE} amg_sexample_1lev.f90)
|
||||
set(CMOBJS ${COMMON_SOURCE} amg_cexample_ml.f90)
|
||||
set(C1OBJS ${COMMON_SOURCE} amg_cexample_1lev.f90)
|
||||
|
||||
# Function to create executable
|
||||
macro(create_amg_executable target sources)
|
||||
add_executable(${target} ${sources})
|
||||
target_link_libraries(${target} PUBLIC
|
||||
${AMG_LIBS}
|
||||
${PSBLAS_LIBS}
|
||||
|
||||
)
|
||||
|
||||
# Move executable to EXEDIR (post-build)
|
||||
#add_custom_command(TARGET ${target} POST_BUILD
|
||||
# COMMAND ${CMAKE_COMMAND} -E move $<TARGET_FILE:${target}> ${EXEDIR}
|
||||
#)
|
||||
set_target_properties(${target} PROPERTIES
|
||||
RUNTIME_OUTPUT_DIRECTORY ${EXEDIR}
|
||||
)
|
||||
endmacro()
|
||||
|
||||
# Create executables
|
||||
create_amg_executable(amg_dexample_ml "${DMOBJS}")
|
||||
create_amg_executable(amg_dexample_1lev "${D1OBJS}")
|
||||
create_amg_executable(amg_zexample_ml "${ZMOBJS}")
|
||||
create_amg_executable(amg_zexample_1lev "${Z1OBJS}")
|
||||
create_amg_executable(amg_sexample_ml "${SMOBJS}")
|
||||
create_amg_executable(amg_sexample_1lev "${S1OBJS}")
|
||||
create_amg_executable(amg_cexample_ml "${CMOBJS}")
|
||||
create_amg_executable(amg_cexample_1lev "${C1OBJS}")
|
||||
|
||||
# Create "runs" directory (if it doesn't exist)
|
||||
add_custom_target(create_runs_dir
|
||||
COMMAND ${CMAKE_COMMAND} -E make_directory "${EXEDIR}"
|
||||
WORKING_DIRECTORY ${CMAKE_CURRENT_SOURCE_DIR}
|
||||
COMMENT "Creating runs directory"
|
||||
)
|
||||
add_dependencies(amg_dexample_ml create_runs_dir)
|
||||
add_dependencies(amg_dexample_1lev create_runs_dir)
|
||||
add_dependencies(amg_zexample_ml create_runs_dir)
|
||||
add_dependencies(amg_zexample_1lev create_runs_dir)
|
||||
add_dependencies(amg_sexample_ml create_runs_dir)
|
||||
add_dependencies(amg_sexample_1lev create_runs_dir)
|
||||
add_dependencies(amg_cexample_ml create_runs_dir)
|
||||
add_dependencies(amg_cexample_1lev create_runs_dir)
|
||||
|
||||
|
||||
# lib target
|
||||
add_custom_target(lib
|
||||
COMMAND ${CMAKE_COMMAND} -E chdir "../../" ${CMAKE_COMMAND} --build . --target library
|
||||
WORKING_DIRECTORY ${CMAKE_CURRENT_SOURCE_DIR}
|
||||
COMMENT "Building library"
|
||||
)
|
||||
|
||||
# verycleanlib target
|
||||
add_custom_target(verycleanlib
|
||||
COMMAND ${CMAKE_COMMAND} -E chdir "../../" ${CMAKE_COMMAND} --build . --target veryclean
|
||||
WORKING_DIRECTORY ${CMAKE_CURRENT_SOURCE_DIR}
|
||||
COMMENT "Cleaning library"
|
||||
)
|
||||
|
||||
# Install target (optional)
|
||||
install(TARGETS
|
||||
amg_dexample_ml
|
||||
amg_dexample_1lev
|
||||
amg_zexample_ml
|
||||
amg_zexample_1lev
|
||||
amg_sexample_ml
|
||||
amg_sexample_1lev
|
||||
amg_cexample_ml
|
||||
amg_cexample_1lev
|
||||
DESTINATION bin
|
||||
)
|
||||
@@ -328,7 +328,9 @@ contains
|
||||
write(psb_err_unit,*) 'Opened file ',trim(filename),' for input'
|
||||
end if
|
||||
else
|
||||
inp_unit=psb_inp_unit
|
||||
write(psb_err_unit,*) 'Usage: amg_cexample_1lev ctrl-file '
|
||||
call psb_abort(ctxt)
|
||||
stop
|
||||
end if
|
||||
! read input parameters
|
||||
call read_data(mtrx,inp_unit)
|
||||
|
||||
@@ -378,7 +378,9 @@ contains
|
||||
write(psb_err_unit,*) 'Opened file ',trim(filename),' for input'
|
||||
end if
|
||||
else
|
||||
inp_unit=psb_inp_unit
|
||||
write(psb_err_unit,*) 'Usage: amg_cexample_ml ctrl-file '
|
||||
call psb_abort(ctxt)
|
||||
stop
|
||||
end if
|
||||
! read input parameters
|
||||
call read_data(mtrx,inp_unit)
|
||||
|
||||
@@ -328,7 +328,9 @@ contains
|
||||
write(psb_err_unit,*) 'Opened file ',trim(filename),' for input'
|
||||
end if
|
||||
else
|
||||
inp_unit=psb_inp_unit
|
||||
write(psb_err_unit,*) 'Usage: amg_dexample_1lev ctrl-file '
|
||||
call psb_abort(ctxt)
|
||||
stop
|
||||
end if
|
||||
! read input parameters
|
||||
call read_data(mtrx,inp_unit)
|
||||
|
||||
@@ -378,7 +378,9 @@ contains
|
||||
write(psb_err_unit,*) 'Opened file ',trim(filename),' for input'
|
||||
end if
|
||||
else
|
||||
inp_unit=psb_inp_unit
|
||||
write(psb_err_unit,*) 'Usage: amg_dexample_ml ctrl-file '
|
||||
call psb_abort(ctxt)
|
||||
stop
|
||||
end if
|
||||
! read input parameters
|
||||
call read_data(mtrx,inp_unit)
|
||||
|
||||
@@ -328,7 +328,9 @@ contains
|
||||
write(psb_err_unit,*) 'Opened file ',trim(filename),' for input'
|
||||
end if
|
||||
else
|
||||
inp_unit=psb_inp_unit
|
||||
write(psb_err_unit,*) 'Usage: amg_sexample_1lev ctrl-file '
|
||||
call psb_abort(ctxt)
|
||||
stop
|
||||
end if
|
||||
! read input parameters
|
||||
call read_data(mtrx,inp_unit)
|
||||
|
||||
@@ -378,7 +378,9 @@ contains
|
||||
write(psb_err_unit,*) 'Opened file ',trim(filename),' for input'
|
||||
end if
|
||||
else
|
||||
inp_unit=psb_inp_unit
|
||||
write(psb_err_unit,*) 'Usage: amg_sexample_ml ctrl-file '
|
||||
call psb_abort(ctxt)
|
||||
stop
|
||||
end if
|
||||
! read input parameters
|
||||
call read_data(mtrx,inp_unit)
|
||||
|
||||
@@ -328,7 +328,9 @@ contains
|
||||
write(psb_err_unit,*) 'Opened file ',trim(filename),' for input'
|
||||
end if
|
||||
else
|
||||
inp_unit=psb_inp_unit
|
||||
write(psb_err_unit,*) 'Usage: amg_zexample_1lev ctrl-file '
|
||||
call psb_abort(ctxt)
|
||||
stop
|
||||
end if
|
||||
! read input parameters
|
||||
call read_data(mtrx,inp_unit)
|
||||
|
||||
@@ -378,7 +378,9 @@ contains
|
||||
write(psb_err_unit,*) 'Opened file ',trim(filename),' for input'
|
||||
end if
|
||||
else
|
||||
inp_unit=psb_inp_unit
|
||||
write(psb_err_unit,*) 'Usage: amg_zexample_ml ctrl-file '
|
||||
call psb_abort(ctxt)
|
||||
stop
|
||||
end if
|
||||
! read input parameters
|
||||
call read_data(mtrx,inp_unit)
|
||||
|
||||
Some files were not shown because too many files have changed in this diff Show More
Reference in New Issue
Block a user