mirror of
https://github.com/sfilippone/amg4psblas.git
synced 2026-10-06 22:55:12 +00:00
Compare commits
100
Commits
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
9cf27f6c46 | ||
|
|
8ac5b90454 | ||
|
|
23f84ce236 | ||
|
|
42313bb843 | ||
|
|
b7ac77da69 | ||
|
|
8a66a7b214 | ||
|
|
8f0718c296 | ||
|
|
62f5501761 | ||
|
|
d833362f4b | ||
|
|
f26b66334a | ||
|
|
d45fffe482 | ||
|
|
f99b563f83 | ||
|
|
b1c4b08d6e | ||
|
|
0e1d7de857 | ||
|
|
a22725b787 | ||
|
|
74a9ca90cb | ||
|
|
0d38955a2d | ||
|
|
9be4a3f1be | ||
|
|
04d7122380 | ||
|
|
087dc37868 | ||
|
|
8e685aa3ae | ||
|
|
6dbe4c96f2 | ||
|
|
f012a9d05e | ||
|
|
93ea03ef1c | ||
|
|
5663188b8c | ||
|
|
8ac05fd00e | ||
|
|
c278c2a69a | ||
|
|
eae53162af | ||
|
|
0b2a212523 | ||
|
|
7b255aaf6f | ||
|
|
4c9687c89b | ||
|
|
a1952a5bf8 | ||
|
|
d2070bcc05 | ||
|
|
f760396403 | ||
|
|
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 |
@@ -0,0 +1,12 @@
|
||||
$Format:%d%n%n$
|
||||
# Fall back version, probably last release:
|
||||
1.2.1
|
||||
|
||||
# AMG4PSBLAS version file.
|
||||
#
|
||||
# Release archive created from commit:
|
||||
# $Format:%H %d$
|
||||
# $Format:Created on %ci by %cN, and$
|
||||
# $Format:signed by %GS using %GK.$
|
||||
# $Format:Signature status: %G?$
|
||||
$Format:%GG$
|
||||
@@ -0,0 +1,28 @@
|
||||
*.a export-ignore
|
||||
*.o export-ignore
|
||||
*.mod export-ignore
|
||||
*.smod export-ignore
|
||||
*~ export-ignore
|
||||
.git* export-ignore
|
||||
|
||||
Make.inc export-ignore
|
||||
config export-ignore
|
||||
config/ export-ignore
|
||||
config/** export-ignore
|
||||
configure.ac export-ignore
|
||||
config.log export-ignore
|
||||
config.status export-ignore
|
||||
aclocal.m4 export-ignore
|
||||
autogen.sh export-ignore
|
||||
autom4te.cache export-ignore
|
||||
Dockerfile export-ignore
|
||||
.travis.yml export-ignore
|
||||
# generated folder
|
||||
./include/** export-ignore
|
||||
./modules/** export-ignore
|
||||
docs/src export-ignore
|
||||
docs/doxypsb export-ignore
|
||||
docs/Makefile export-ignore
|
||||
|
||||
# the executable from tests
|
||||
|
||||
+191
-28
@@ -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")
|
||||
@@ -13,23 +13,35 @@ endif()
|
||||
|
||||
|
||||
# Check for the installation path for psblas
|
||||
#if(NOT DEFINED PSBLAS_INSTALL_DIR)
|
||||
# message(FATAL_ERROR "Please specify the path to the psblas installation directory using -DPSBLAS_INSTALL_DIR=<path>")
|
||||
#endif()
|
||||
message(STATUS "psblas directory is ${PSBLAS_INSTALL_DIR};;")
|
||||
|
||||
message(STATUS "psblas directory is ${PSBLAS_INSTALL_DIR};")
|
||||
|
||||
message(STATUS "PSBLAS DIRECTORY INC ${INCDIR}; MOD ${MODDIR}; LIB ${LIBDIR};")
|
||||
|
||||
#set(CMAKE_CXX_STANDARD 17) # Set cxx standard for the c++ part of the library
|
||||
|
||||
|
||||
# Find the psblas package
|
||||
find_package(psblas REQUIRED PATHS ${PSBLAS_INSTALL_DIR})
|
||||
|
||||
if(NOT psblas_FOUND)
|
||||
message(FATAL_ERROR "PSBLAS not found!")
|
||||
else()
|
||||
message(STATUS "Found PSBLAS: ${psblas_LIBRARIES}")
|
||||
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 +51,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 +154,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 +189,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,8 +270,43 @@ 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()
|
||||
|
||||
# Find AMG constants
|
||||
include(${CMAKE_CURRENT_LIST_DIR}/cmake/readAMGConst.cmake)
|
||||
_amg_read_const()
|
||||
|
||||
if ("${PSB_LPK_SIZE}" EQUAL 8)
|
||||
set(CXXMATCHBOXBIT "#define AMG_MATCHBOXP_BIT64")
|
||||
endif()
|
||||
|
||||
|
||||
#------------------------------------------
|
||||
@@ -205,8 +326,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 +339,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 +377,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 +396,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
|
||||
)
|
||||
|
||||
@@ -289,7 +425,9 @@ target_include_directories(amgcbind PUBLIC ${INCDIR} ${MODDIR})
|
||||
target_link_libraries(amgcbind
|
||||
#PUBLIC ${LAPACK_LINKER_FLAGS} ${LAPACK_LIBRARIES} ${LAPACK95_LIBRARIES}
|
||||
#PUBLIC ${BLAS_LINKER_FLAGS} ${BLAS_LIBRARIES} ${BLAS95_LIBRARIES}
|
||||
PUBLIC amgprec psblas::util psblas::linsolve psblas::prec psblas::ext psblas::cbind psblas::base) #TODO check actual libraries needed
|
||||
PUBLIC amgprec psblas::util psblas::linsolve psblas::prec
|
||||
psblas::ext psblas::cbind psblas::base)
|
||||
#TODO check actual libraries needed
|
||||
|
||||
|
||||
|
||||
@@ -354,25 +492,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")
|
||||
|
||||
|
||||
|
||||
|
||||
@@ -4,12 +4,10 @@
|
||||
Algebraic Multigrid Package
|
||||
based on PSBLAS (Parallel Sparse BLAS version 3.9)
|
||||
|
||||
(C) Copyright 2025
|
||||
|
||||
Salvatore Filippone
|
||||
Pasqua D'Ambra
|
||||
Fabio Durastante
|
||||
|
||||
(C) Copyright 2025 Salvatore Filippone
|
||||
(C) Copyright 2025 Pasqua D'Ambra
|
||||
(C) Copyright 2025 Fabio Durastante
|
||||
|
||||
Redistribution and use in source and binary forms, with or without
|
||||
modification, are permitted provided that the following conditions
|
||||
are met:
|
||||
@@ -20,7 +18,7 @@
|
||||
documentation and/or other materials provided with the distribution.
|
||||
3. The name of the AMG4PSBLAS group or the names of its contributors may
|
||||
not be used to endorse or promote products derived from this
|
||||
software without specific written permission.
|
||||
software without specific prior written permission.
|
||||
|
||||
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
|
||||
+2
-1
@@ -70,7 +70,8 @@ EXTRALIBS=@EXTRA_LIBS@
|
||||
|
||||
|
||||
#
|
||||
AMGCDEFINES=$(MUMPSFLAGS) $(SLUFLAGS) $(UMFFLAGS) $(SLUDISTFLAGS) $(PSBCDEFINES)
|
||||
AMGCDEFINES=$(SLUFLAGS) $(UMFFLAGS) $(SLUDISTFLAGS)
|
||||
#$(PSBCDEFINES) $(MUMPSFLAGS)
|
||||
CDEFINES=$(AMGCDEFINES)
|
||||
AMGFDEFINES=@AMGFDEFINES@ $(PSBFDEFINES)
|
||||
FDEFINES=$(AMGFDEFINES)
|
||||
|
||||
@@ -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: amgobjs
|
||||
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()
|
||||
|
||||
+11
-12
@@ -58,30 +58,29 @@ 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)
|
||||
/bin/cp -p amg_const.h amg_config.h $(INCDIR)
|
||||
mods: $(MODOBJS)
|
||||
/bin/cp -p 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)
|
||||
|
||||
|
||||
$(MODOBJS): $(PSBLAS_MODDIR)/$(PSBBASEMODNAME)$(.mod)
|
||||
|
||||
amg_base_prec_type.o: amg_const.h
|
||||
amg_base_prec_type.o: amg_config.h
|
||||
amg_s_prec_type.o amg_d_prec_type.o amg_c_prec_type.o amg_z_prec_type.o : amg_base_prec_type.o
|
||||
amg_prec_type.o: amg_s_prec_type.o amg_d_prec_type.o amg_c_prec_type.o amg_z_prec_type.o
|
||||
amg_prec_mod.o: amg_prec_type.o amg_s_prec_mod.o amg_d_prec_mod.o amg_c_prec_mod.o amg_z_prec_mod.o
|
||||
@@ -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
|
||||
|
||||
@@ -1,16 +0,0 @@
|
||||
#!/bin/bash
|
||||
hn=amg_const.h
|
||||
fn=amg_base_prec_type.F90
|
||||
echo "/* This file was generated by a script using the $fn file as a basis. */" > $hn
|
||||
echo '#ifndef AMG_CONST_H_' >> $hn
|
||||
echo '#define AMG_CONST_H_' >> $hn
|
||||
echo '#ifdef __cplusplus' >> $hn
|
||||
echo 'extern "C" { ' >> $hn
|
||||
echo '#endif' >> $hn
|
||||
cat $fn | sed 's/=/= (/g;s/$/ )/g' | grep '\(^ *!\)\|parameter' | grep '_\>' | sed 's/^\s*//g;s/^.*:://g;s/\s*=\s*/ /g' | sed 's/,/\n/g;s/^ //g' | tr '[:lower:]' '[:upper:]' | grep ^AMG | sed 's/^/#define /g' >> $hn
|
||||
echo '#ifdef __cplusplus' >> $hn
|
||||
echo '}' >> $hn
|
||||
echo '#endif' >> $hn
|
||||
echo '#endif' >> $hn
|
||||
exit
|
||||
|
||||
@@ -17,7 +17,7 @@
|
||||
! documentation and/or other materials provided with the distribution.
|
||||
! 3. The name of the AMG4PSBLAS group or the names of its contributors may
|
||||
! not be used to endorse or promote products derived from this
|
||||
! software without specific written permission.
|
||||
! software without specific prior written permission.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
|
||||
@@ -17,7 +17,7 @@
|
||||
! documentation and/or other materials provided with the distribution.
|
||||
! 3. The name of the AMG4PSBLAS group or the names of its contributors may
|
||||
! not be used to endorse or promote products derived from this
|
||||
! software without specific written permission.
|
||||
! software without specific prior written permission.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
|
||||
@@ -20,7 +20,7 @@
|
||||
! documentation and/or other materials provided with the distribution.
|
||||
! 3. The name of the AMG4PSBLAS group or the names of its contributors may
|
||||
! not be used to endorse or promote products derived from this
|
||||
! software without specific written permission.
|
||||
! software without specific prior written permission.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
@@ -84,7 +84,7 @@ module amg_base_prec_type
|
||||
character(len=*), parameter :: amg_version_string_ = "1.2.0"
|
||||
integer(psb_ipk_), parameter :: amg_version_major_ = 1
|
||||
integer(psb_ipk_), parameter :: amg_version_minor_ = 2
|
||||
integer(psb_ipk_), parameter :: amg_patchlevel_ = 0
|
||||
integer(psb_ipk_), parameter :: amg_patchlevel_ = 1
|
||||
|
||||
type amg_ml_parms
|
||||
integer(psb_ipk_) :: sweeps_pre, sweeps_post
|
||||
|
||||
@@ -20,7 +20,7 @@
|
||||
! documentation and/or other materials provided with the distribution.
|
||||
! 3. The name of the AMG4PSBLAS group or the names of its contributors may
|
||||
! not be used to endorse or promote products derived from this
|
||||
! software without specific written permission.
|
||||
! software without specific prior written permission.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
@@ -103,7 +103,7 @@ module amg_c_ainv_solver
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
type(psb_cspmat_type), intent(in), target :: a
|
||||
type(psb_cspmat_type), intent(inout), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_c_ainv_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
@@ -225,7 +225,7 @@ module amg_c_ainv_solver
|
||||
import :: psb_desc_type, psb_cspmat_type, psb_c_base_sparse_mat, &
|
||||
& psb_d_vect_type, psb_c_base_vect_type, psb_spk_, psb_ipk_
|
||||
implicit none
|
||||
type(psb_cspmat_type), intent(in), target :: a
|
||||
type(psb_cspmat_type), intent(inout), target :: a
|
||||
integer(psb_ipk_), intent(in) :: fillin,alg
|
||||
real(psb_spk_), intent(in) :: thresh
|
||||
type(psb_cspmat_type), intent(inout) :: wmat, zmat
|
||||
|
||||
@@ -20,7 +20,7 @@
|
||||
! documentation and/or other materials provided with the distribution.
|
||||
! 3. The name of the AMG4PSBLAS group or the names of its contributors may
|
||||
! not be used to endorse or promote products derived from this
|
||||
! software without specific written permission.
|
||||
! software without specific prior written permission.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
@@ -230,7 +230,7 @@ module amg_c_as_smoother
|
||||
& psb_desc_type, psb_c_base_sparse_mat, psb_ipk_,&
|
||||
& psb_i_base_vect_type
|
||||
implicit none
|
||||
type(psb_cspmat_type), intent(in), target :: a
|
||||
type(psb_cspmat_type), intent(inout), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_c_as_smoother_type), intent(inout) :: sm
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
@@ -20,7 +20,7 @@
|
||||
! documentation and/or other materials provided with the distribution.
|
||||
! 3. The name of the AMG4PSBLAS group or the names of its contributors may
|
||||
! not be used to endorse or promote products derived from this
|
||||
! software without specific written permission.
|
||||
! software without specific prior written permission.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
@@ -89,7 +89,7 @@ module amg_c_base_aggregator_mod
|
||||
procedure, pass(ag) :: bld_tprol => amg_c_base_aggregator_build_tprol
|
||||
procedure, pass(ag) :: mat_bld => amg_c_base_aggregator_mat_bld
|
||||
procedure, pass(ag) :: mat_asb => amg_c_base_aggregator_mat_asb
|
||||
procedure, pass(ag) :: bld_map => amg_c_base_aggregator_bld_map
|
||||
procedure, pass(ag) :: bld_linmap => amg_c_base_aggregator_bld_linmap
|
||||
procedure, pass(ag) :: update_next => amg_c_base_aggregator_update_next
|
||||
procedure, pass(ag) :: clone => amg_c_base_aggregator_clone
|
||||
procedure, pass(ag) :: free => amg_c_base_aggregator_free
|
||||
@@ -458,7 +458,7 @@ contains
|
||||
end subroutine amg_c_base_aggregator_mat_asb
|
||||
|
||||
!
|
||||
!> Function bld_map
|
||||
!> Function bld_linmap
|
||||
!! \memberof amg_c_base_aggregator_type
|
||||
!! \brief Build linear map between hierarchy levels
|
||||
!!
|
||||
@@ -473,7 +473,7 @@ contains
|
||||
!! \param map The output map
|
||||
!! \param info Return code
|
||||
!!
|
||||
subroutine amg_c_base_aggregator_bld_map(ag,desc_a,desc_ac,ilaggr,nlaggr,&
|
||||
subroutine amg_c_base_aggregator_bld_linmap(ag,desc_a,desc_ac,ilaggr,nlaggr,&
|
||||
& op_restr,op_prol,map,info)
|
||||
use psb_base_mod
|
||||
implicit none
|
||||
@@ -484,7 +484,7 @@ contains
|
||||
type(psb_clinmap_type), intent(out) :: map
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20) :: name='c_base_aggregator_bld_map'
|
||||
character(len=20) :: name='c_base_aggregator_bld_linmap'
|
||||
|
||||
info = psb_success_
|
||||
call psb_erractionsave(err_act)
|
||||
@@ -508,7 +508,6 @@ contains
|
||||
9999 call psb_error_handler(err_act)
|
||||
|
||||
return
|
||||
end subroutine amg_c_base_aggregator_bld_map
|
||||
|
||||
end subroutine amg_c_base_aggregator_bld_linmap
|
||||
|
||||
end module amg_c_base_aggregator_mod
|
||||
|
||||
@@ -20,7 +20,7 @@
|
||||
! documentation and/or other materials provided with the distribution.
|
||||
! 3. The name of the AMG4PSBLAS group or the names of its contributors may
|
||||
! not be used to endorse or promote products derived from this
|
||||
! software without specific written permission.
|
||||
! software without specific prior written permission.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
|
||||
@@ -20,7 +20,7 @@
|
||||
! documentation and/or other materials provided with the distribution.
|
||||
! 3. The name of the AMG4PSBLAS group or the names of its contributors may
|
||||
! not be used to endorse or promote products derived from this
|
||||
! software without specific written permission.
|
||||
! software without specific prior written permission.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
@@ -237,7 +237,7 @@ module amg_c_base_smoother_mod
|
||||
& psb_c_vect_type, psb_c_base_vect_type, psb_spk_, &
|
||||
& amg_c_base_smoother_type, psb_ipk_, psb_i_base_vect_type
|
||||
! Arguments
|
||||
type(psb_cspmat_type), intent(in), target :: a
|
||||
type(psb_cspmat_type), intent(inout), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_c_base_smoother_type), intent(inout) :: sm
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
@@ -20,7 +20,7 @@
|
||||
! documentation and/or other materials provided with the distribution.
|
||||
! 3. The name of the AMG4PSBLAS group or the names of its contributors may
|
||||
! not be used to endorse or promote products derived from this
|
||||
! software without specific written permission.
|
||||
! software without specific prior written permission.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
@@ -170,7 +170,7 @@ module amg_c_base_solver_mod
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
type(psb_cspmat_type), intent(in), target :: a
|
||||
type(psb_cspmat_type), intent(inout), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_c_base_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
@@ -20,7 +20,7 @@
|
||||
! documentation and/or other materials provided with the distribution.
|
||||
! 3. The name of the AMG4PSBLAS group or the names of its contributors may
|
||||
! not be used to endorse or promote products derived from this
|
||||
! software without specific written permission.
|
||||
! software without specific prior written permission.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
|
||||
@@ -20,7 +20,7 @@
|
||||
! documentation and/or other materials provided with the distribution.
|
||||
! 3. The name of the AMG4PSBLAS group or the names of its contributors may
|
||||
! not be used to endorse or promote products derived from this
|
||||
! software without specific written permission.
|
||||
! software without specific prior written permission.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
@@ -119,7 +119,7 @@ module amg_c_diag_solver
|
||||
import :: psb_desc_type, psb_cspmat_type, psb_c_base_sparse_mat, &
|
||||
& psb_c_vect_type, psb_c_base_vect_type, psb_spk_, &
|
||||
& amg_c_diag_solver_type, psb_ipk_, psb_i_base_vect_type
|
||||
type(psb_cspmat_type), intent(in), target :: a
|
||||
type(psb_cspmat_type), intent(inout), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_c_diag_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
@@ -331,7 +331,7 @@ module amg_c_l1_diag_solver
|
||||
import :: psb_desc_type, psb_cspmat_type, psb_c_base_sparse_mat, &
|
||||
& psb_c_vect_type, psb_c_base_vect_type, psb_spk_, &
|
||||
& amg_c_l1_diag_solver_type, psb_ipk_, psb_i_base_vect_type
|
||||
type(psb_cspmat_type), intent(in), target :: a
|
||||
type(psb_cspmat_type), intent(inout), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_c_l1_diag_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
@@ -20,7 +20,7 @@
|
||||
! documentation and/or other materials provided with the distribution.
|
||||
! 3. The name of the AMG4PSBLAS group or the names of its contributors may
|
||||
! not be used to endorse or promote products derived from this
|
||||
! software without specific written permission.
|
||||
! software without specific prior written permission.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
@@ -181,7 +181,7 @@ module amg_c_gs_solver
|
||||
& psb_cspmat_type, psb_c_base_sparse_mat, psb_c_base_vect_type,&
|
||||
& psb_ipk_, psb_i_base_vect_type
|
||||
implicit none
|
||||
type(psb_cspmat_type), intent(in), target :: a
|
||||
type(psb_cspmat_type), intent(inout), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_c_gs_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
@@ -195,7 +195,7 @@ module amg_c_gs_solver
|
||||
& psb_cspmat_type, psb_c_base_sparse_mat, psb_c_base_vect_type,&
|
||||
& psb_ipk_, psb_i_base_vect_type
|
||||
implicit none
|
||||
type(psb_cspmat_type), intent(in), target :: a
|
||||
type(psb_cspmat_type), intent(inout), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_c_bwgs_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
@@ -20,7 +20,7 @@
|
||||
! documentation and/or other materials provided with the distribution.
|
||||
! 3. The name of the AMG4PSBLAS group or the names of its contributors may
|
||||
! not be used to endorse or promote products derived from this
|
||||
! software without specific written permission.
|
||||
! software without specific prior written permission.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
@@ -123,7 +123,7 @@ contains
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
type(psb_cspmat_type), intent(in), target :: a
|
||||
type(psb_cspmat_type), intent(inout), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_c_id_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
@@ -20,7 +20,7 @@
|
||||
! documentation and/or other materials provided with the distribution.
|
||||
! 3. The name of the AMG4PSBLAS group or the names of its contributors may
|
||||
! not be used to endorse or promote products derived from this
|
||||
! software without specific written permission.
|
||||
! software without specific prior written permission.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
|
||||
@@ -20,7 +20,7 @@
|
||||
! documentation and/or other materials provided with the distribution.
|
||||
! 3. The name of the AMG4PSBLAS group or the names of its contributors may
|
||||
! not be used to endorse or promote products derived from this
|
||||
! software without specific written permission.
|
||||
! software without specific prior written permission.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
@@ -144,7 +144,7 @@ module amg_c_ilu_solver
|
||||
& psb_cspmat_type, psb_c_base_sparse_mat, psb_c_base_vect_type,&
|
||||
& psb_ipk_, psb_i_base_vect_type
|
||||
implicit none
|
||||
type(psb_cspmat_type), intent(in), target :: a
|
||||
type(psb_cspmat_type), intent(inout), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_c_ilu_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
@@ -20,7 +20,7 @@
|
||||
! documentation and/or other materials provided with the distribution.
|
||||
! 3. The name of the AMG4PSBLAS group or the names of its contributors may
|
||||
! not be used to endorse or promote products derived from this
|
||||
! software without specific written permission.
|
||||
! software without specific prior written permission.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
@@ -56,7 +56,7 @@ module amg_c_inner_mod
|
||||
& psb_spk_, psb_c_base_sparse_mat, psb_c_base_vect_type, psb_ipk_
|
||||
import :: amg_cprec_type
|
||||
implicit none
|
||||
type(psb_cspmat_type), intent(in), target :: a
|
||||
type(psb_cspmat_type), intent(inout), target :: a
|
||||
type(psb_desc_type), intent(inout), target :: desc_a
|
||||
type(amg_cprec_type), intent(inout), target :: prec
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
@@ -67,7 +67,7 @@ module amg_c_inner_mod
|
||||
end interface amg_mlprec_bld
|
||||
|
||||
interface amg_mlprec_aply
|
||||
subroutine amg_cmlprec_aply(alpha,p,x,beta,y,desc_data,trans,work,info)
|
||||
subroutine amg_cmlprec_aply_a(alpha,p,x,beta,y,desc_data,trans,work,info)
|
||||
import :: psb_cspmat_type, psb_desc_type, psb_spk_, psb_ipk_
|
||||
import :: amg_cprec_type
|
||||
implicit none
|
||||
@@ -79,7 +79,7 @@ module amg_c_inner_mod
|
||||
character,intent(in) :: trans
|
||||
complex(psb_spk_),target :: work(:)
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine amg_cmlprec_aply
|
||||
end subroutine amg_cmlprec_aply_a
|
||||
subroutine amg_cmlprec_aply_vect(alpha,p,x,beta,y,desc_data,trans,work,info)
|
||||
import :: psb_cspmat_type, psb_desc_type, &
|
||||
& psb_spk_, psb_c_vect_type, psb_ipk_
|
||||
|
||||
@@ -20,7 +20,7 @@
|
||||
! documentation and/or other materials provided with the distribution.
|
||||
! 3. The name of the AMG4PSBLAS group or the names of its contributors may
|
||||
! not be used to endorse or promote products derived from this
|
||||
! software without specific written permission.
|
||||
! software without specific prior written permission.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
@@ -94,7 +94,7 @@ module amg_c_invk_solver
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
type(psb_cspmat_type), intent(in), target :: a
|
||||
type(psb_cspmat_type), intent(inout), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_c_invk_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
@@ -20,7 +20,7 @@
|
||||
! documentation and/or other materials provided with the distribution.
|
||||
! 3. The name of the AMG4PSBLAS group or the names of its contributors may
|
||||
! not be used to endorse or promote products derived from this
|
||||
! software without specific written permission.
|
||||
! software without specific prior written permission.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
@@ -94,7 +94,7 @@ module amg_c_invt_solver
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
type(psb_cspmat_type), intent(in), target :: a
|
||||
type(psb_cspmat_type), intent(inout), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_c_invt_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
@@ -20,7 +20,7 @@
|
||||
! documentation and/or other materials provided with the distribution.
|
||||
! 3. The name of the AMG4PSBLAS group or the names of its contributors may
|
||||
! not be used to endorse or promote products derived from this
|
||||
! software without specific written permission.
|
||||
! software without specific prior written permission.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
@@ -151,7 +151,7 @@ module amg_c_jac_smoother
|
||||
import :: psb_desc_type, amg_c_jac_smoother_type, psb_c_vect_type, psb_spk_, &
|
||||
& psb_cspmat_type, psb_c_base_sparse_mat, psb_c_base_vect_type,&
|
||||
& psb_ipk_, psb_i_base_vect_type
|
||||
type(psb_cspmat_type), intent(in), target :: a
|
||||
type(psb_cspmat_type), intent(inout), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_c_jac_smoother_type), intent(inout) :: sm
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
@@ -274,7 +274,7 @@ module amg_c_jac_smoother
|
||||
import :: psb_desc_type, amg_c_l1_jac_smoother_type, psb_c_vect_type, &
|
||||
& psb_cspmat_type, psb_c_base_sparse_mat, psb_c_base_vect_type,&
|
||||
& psb_ipk_, psb_i_base_vect_type
|
||||
type(psb_cspmat_type), intent(in), target :: a
|
||||
type(psb_cspmat_type), intent(inout), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_c_l1_jac_smoother_type), intent(inout) :: sm
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
@@ -20,7 +20,7 @@
|
||||
! documentation and/or other materials provided with the distribution.
|
||||
! 3. The name of the AMG4PSBLAS group or the names of its contributors may
|
||||
! not be used to endorse or promote products derived from this
|
||||
! software without specific written permission.
|
||||
! software without specific prior written permission.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
@@ -143,7 +143,7 @@ module amg_c_jac_solver
|
||||
& psb_cspmat_type, psb_c_base_sparse_mat, psb_c_base_vect_type,&
|
||||
& psb_ipk_, psb_i_base_vect_type
|
||||
implicit none
|
||||
type(psb_cspmat_type), intent(in), target :: a
|
||||
type(psb_cspmat_type), intent(inout), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_c_jac_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
@@ -160,7 +160,7 @@ module amg_c_jac_solver
|
||||
& psb_cspmat_type, psb_c_base_sparse_mat, psb_c_base_vect_type,&
|
||||
& psb_ipk_, psb_i_base_vect_type
|
||||
implicit none
|
||||
type(psb_cspmat_type), intent(in), target :: a
|
||||
type(psb_cspmat_type), intent(inout), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_c_l1_jac_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
@@ -23,7 +23,7 @@
|
||||
! documentation and/or other materials provided with the distribution.
|
||||
! 3. The name of the AMG4PSBLAS group or the names of its contributors may
|
||||
! not be used to endorse or promote products derived from this
|
||||
! software without specific written permission.
|
||||
! software without specific prior written permission.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
@@ -57,7 +57,7 @@
|
||||
! documentation and/or other materials provided with the distribution.
|
||||
! 3. The name of the AMG4PSBLAS group or the names of its contributors may
|
||||
! not be used to endorse or promote products derived from this
|
||||
! software without specific written permission.
|
||||
! software without specific prior written permission.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
@@ -174,7 +174,7 @@ module amg_c_krm_solver
|
||||
& psb_cspmat_type, psb_c_base_sparse_mat, psb_c_base_vect_type,&
|
||||
& psb_ipk_, psb_i_base_vect_type
|
||||
implicit none
|
||||
type(psb_cspmat_type), intent(in), target :: a
|
||||
type(psb_cspmat_type), intent(inout), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_c_krm_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
@@ -21,7 +21,7 @@
|
||||
! documentation and/or other materials provided with the distribution.
|
||||
! 3. The name of the AMG4PSBLAS group or the names of its contributors may
|
||||
! not be used to endorse or promote products derived from this
|
||||
! software without specific written permission.
|
||||
! software without specific prior written permission.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
@@ -163,7 +163,7 @@ module amg_c_mumps_solver
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
type(psb_cspmat_type), intent(in), target :: a
|
||||
type(psb_cspmat_type), intent(inout), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_c_mumps_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
@@ -20,7 +20,7 @@
|
||||
! documentation and/or other materials provided with the distribution.
|
||||
! 3. The name of the AMG4PSBLAS group or the names of its contributors may
|
||||
! not be used to endorse or promote products derived from this
|
||||
! software without specific written permission.
|
||||
! software without specific prior written permission.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
@@ -154,13 +154,35 @@ module amg_c_onelev_mod
|
||||
private :: c_wrk_alloc, c_wrk_free, &
|
||||
& c_wrk_clone, c_wrk_move_alloc, c_wrk_cnv, c_wrk_sizeof
|
||||
|
||||
!
|
||||
! Remap.
|
||||
! This keeps track of remapping.
|
||||
! Logic here is as follows:
|
||||
! 1. AC_PRE_REMAP need to figure out if we
|
||||
! really need it.
|
||||
! 2. DESC_AC_PRE_REMAP contains the descriptor before
|
||||
! remapping. Meaning that it is possible
|
||||
! to implement the RESTRICTOR operator by
|
||||
! a. Doing LINMAP_U2V onto this one
|
||||
! b. For each process, send the data to
|
||||
! IDEST.
|
||||
! This assumes that remapping goes by
|
||||
! a factor of 2.
|
||||
! For the PROLONGATOR operators, we first
|
||||
! use DESC_AC, then split and send onto
|
||||
! the processes in DESC_AC_PRE_REMAP.
|
||||
!
|
||||
! To be fixed: what happens if NP the starting processes
|
||||
! is not an even number? Coordinate with _X_remap in PSBLAS
|
||||
!
|
||||
type amg_c_remap_data_type
|
||||
type(psb_cspmat_type) :: ac_pre_remap
|
||||
type(psb_desc_type) :: desc_ac_pre_remap
|
||||
integer(psb_ipk_) :: idest
|
||||
integer(psb_ipk_), allocatable :: isrc(:), nrsrc(:), naggr(:)
|
||||
contains
|
||||
procedure, pass(rmp) :: clone => c_remap_data_clone
|
||||
procedure, pass(rmp) :: clone => c_remap_data_clone
|
||||
procedure, pass(rmp) :: move_alloc => c_remap_move_alloc
|
||||
end type amg_c_remap_data_type
|
||||
|
||||
type amg_c_onelev_type
|
||||
@@ -206,7 +228,7 @@ module amg_c_onelev_mod
|
||||
procedure, pass(lv) :: get_wrksz => c_base_onelev_get_wrksize
|
||||
procedure, pass(lv) :: allocate_wrk => c_base_onelev_allocate_wrk
|
||||
procedure, pass(lv) :: free_wrk => c_base_onelev_free_wrk
|
||||
procedure, nopass :: stringval => amg_stringval
|
||||
procedure, nopass :: stringval => amg_stringval
|
||||
procedure, pass(lv) :: move_alloc => c_base_onelev_move_alloc
|
||||
|
||||
|
||||
@@ -618,7 +640,7 @@ contains
|
||||
! Arguments
|
||||
class(amg_c_onelev_type), target, intent(inout) :: lv
|
||||
class(amg_c_onelev_type), target, intent(inout) :: lvout
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
info = psb_success_
|
||||
if (allocated(lv%sm)) then
|
||||
@@ -684,6 +706,7 @@ contains
|
||||
if (info == psb_success_) call psb_move_alloc(lv%tprol,b%tprol,info)
|
||||
if (info == psb_success_) call psb_move_alloc(lv%desc_ac,b%desc_ac,info)
|
||||
if (info == psb_success_) call psb_move_alloc(lv%linmap,b%linmap,info)
|
||||
if (info == psb_success_) call lv%remap_data%move_alloc(b%remap_data,info)
|
||||
b%base_a => lv%base_a
|
||||
b%base_desc => lv%base_desc
|
||||
|
||||
@@ -738,6 +761,7 @@ contains
|
||||
info = psb_success_
|
||||
nwv = lv%get_wrksz()
|
||||
if (.not.allocated(lv%wrk)) allocate(lv%wrk,stat=info)
|
||||
!!$ write(0,*) 'From allocate_wrk :',lv%remap_data%desc_ac_pre_remap%is_asb()
|
||||
if (info == 0) then
|
||||
if (lv%remap_data%desc_ac_pre_remap%is_asb()) then
|
||||
!
|
||||
@@ -785,47 +809,32 @@ contains
|
||||
|
||||
info = psb_success_
|
||||
call wk%free(info)
|
||||
if (present(desc2)) then
|
||||
!!$ write(0,*) 'Check on wrk_alloc 2',&
|
||||
!!$ & desc2%get_local_rows(), desc%get_local_rows(),&
|
||||
!!$ & desc2%get_local_cols(),desc%get_local_cols()
|
||||
!!$ flush(0)
|
||||
!!$ write(0,*) 'wrk_alloc D: "',trim(desc%get_fmt()),'"',&
|
||||
!!$ & present(desc2),desc%is_valid()
|
||||
|
||||
allocate(wk%wv(nwv),stat=info)
|
||||
if (present(desc2).and.(desc%is_valid())) then
|
||||
!!$ write(0,*) 'wrk_alloc D2:',desc2%get_fmt(),desc2%is_asb()
|
||||
if (desc2%get_local_cols()>desc%get_local_cols()) then
|
||||
call psb_geasb(wk%vx2l,desc2,info,&
|
||||
& scratch=.true.,mold=vmold)
|
||||
call psb_geasb(wk%vy2l,desc2,info,&
|
||||
& scratch=.true.,mold=vmold)
|
||||
call psb_geasb(wk%vtx,desc2,info,&
|
||||
& scratch=.true.,mold=vmold)
|
||||
call psb_geasb(wk%vty,desc2,info,&
|
||||
& scratch=.true.,mold=vmold)
|
||||
allocate(wk%wv(nwv),stat=info)
|
||||
do i=1,nwv
|
||||
call psb_geasb(wk%wv(i),desc2,info,&
|
||||
& scratch=.true.,mold=vmold)
|
||||
end do
|
||||
call inner_do_wrk_alloc(wk,nwv,desc2,vmold=vmold)
|
||||
else
|
||||
!!$ write(0,*) 'Check on wrk_alloc 1.5 ',&
|
||||
!!$ & desc%get_local_rows(),&
|
||||
!!$ & desc%get_local_cols()
|
||||
call psb_geasb(wk%vx2l,desc,info,&
|
||||
& scratch=.true.,mold=vmold)
|
||||
call psb_geasb(wk%vy2l,desc,info,&
|
||||
& scratch=.true.,mold=vmold)
|
||||
call psb_geasb(wk%vtx,desc,info,&
|
||||
& scratch=.true.,mold=vmold)
|
||||
call psb_geasb(wk%vty,desc,info,&
|
||||
& scratch=.true.,mold=vmold)
|
||||
allocate(wk%wv(nwv),stat=info)
|
||||
do i=1,nwv
|
||||
call psb_geasb(wk%wv(i),desc,info,&
|
||||
& scratch=.true.,mold=vmold)
|
||||
end do
|
||||
call inner_do_wrk_alloc(wk,nwv,desc,vmold=vmold)
|
||||
end if
|
||||
else
|
||||
!!$ write(0,*) 'Check on wrk_alloc 1 ',&
|
||||
!!$ & desc%get_local_rows(),&
|
||||
!!$ & desc%get_local_cols()
|
||||
else if (present(desc2)) then
|
||||
call inner_do_wrk_alloc(wk,nwv,desc2,vmold=vmold)
|
||||
else if (desc%is_valid()) then
|
||||
call inner_do_wrk_alloc(wk,nwv,desc,vmold=vmold)
|
||||
end if
|
||||
|
||||
contains
|
||||
subroutine inner_do_wrk_alloc(wk,nwv,desc,vmold)
|
||||
class(amg_cmlprec_wrk_type), target, intent(inout) :: wk
|
||||
integer(psb_ipk_), intent(in) :: nwv
|
||||
type(psb_desc_type), intent(in) :: desc
|
||||
class(psb_c_base_vect_type), intent(in), optional :: vmold
|
||||
|
||||
integer(psb_ipk_) :: i
|
||||
|
||||
call psb_geasb(wk%vx2l,desc,info,&
|
||||
& scratch=.true.,mold=vmold)
|
||||
call psb_geasb(wk%vy2l,desc,info,&
|
||||
@@ -834,12 +843,11 @@ contains
|
||||
& scratch=.true.,mold=vmold)
|
||||
call psb_geasb(wk%vty,desc,info,&
|
||||
& scratch=.true.,mold=vmold)
|
||||
allocate(wk%wv(nwv),stat=info)
|
||||
do i=1,nwv
|
||||
call psb_geasb(wk%wv(i),desc,info,&
|
||||
& scratch=.true.,mold=vmold)
|
||||
end do
|
||||
end if
|
||||
end subroutine inner_do_wrk_alloc
|
||||
end subroutine c_wrk_alloc
|
||||
|
||||
subroutine c_wrk_free(wk,info)
|
||||
@@ -992,4 +1000,25 @@ contains
|
||||
call psb_safe_ab_cpy(rmp%nrsrc,remap_out%nrsrc,info)
|
||||
end subroutine c_remap_data_clone
|
||||
|
||||
subroutine c_remap_move_alloc(rmp, remap_out, info)
|
||||
use psb_base_mod
|
||||
implicit none
|
||||
! Arguments
|
||||
class(amg_c_remap_data_type), target, intent(inout) :: rmp
|
||||
class(amg_c_remap_data_type), target, intent(inout) :: remap_out
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
!
|
||||
integer(psb_ipk_) :: i
|
||||
|
||||
info = psb_success_
|
||||
|
||||
call psb_move_alloc(rmp%ac_pre_remap,remap_out%ac_pre_remap,info)
|
||||
if (info == psb_success_) &
|
||||
& call psb_move_alloc(rmp%desc_ac_pre_remap,remap_out%desc_ac_pre_remap,info)
|
||||
remap_out%idest = rmp%idest
|
||||
call move_alloc(rmp%isrc,remap_out%isrc)
|
||||
call move_alloc(rmp%nrsrc,remap_out%nrsrc)
|
||||
call move_alloc(rmp%naggr,remap_out%naggr)
|
||||
end subroutine c_remap_move_alloc
|
||||
|
||||
end module amg_c_onelev_mod
|
||||
|
||||
@@ -20,7 +20,7 @@
|
||||
! documentation and/or other materials provided with the distribution.
|
||||
! 3. The name of the AMG4PSBLAS group or the names of its contributors may
|
||||
! not be used to endorse or promote products derived from this
|
||||
! software without specific written permission.
|
||||
! software without specific prior written permission.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
|
||||
+42
-40
@@ -20,7 +20,7 @@
|
||||
! documentation and/or other materials provided with the distribution.
|
||||
! 3. The name of the AMG4PSBLAS group or the names of its contributors may
|
||||
! not be used to endorse or promote products derived from this
|
||||
! software without specific written permission.
|
||||
! software without specific prior written permission.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
@@ -102,6 +102,7 @@ module amg_c_prec_type
|
||||
! The multilevel hierarchy
|
||||
!
|
||||
type(amg_c_onelev_type), allocatable :: precv(:)
|
||||
integer(psb_ipk_) :: nlevs
|
||||
contains
|
||||
procedure, pass(prec) :: psb_c_apply2_vect => amg_c_apply2_vect
|
||||
procedure, pass(prec) :: psb_c_apply1_vect => amg_c_apply1_vect
|
||||
@@ -119,6 +120,7 @@ module amg_c_prec_type
|
||||
procedure, pass(prec) :: cmp_complexity => amg_c_cmp_compl
|
||||
procedure, pass(prec) :: get_avg_cr => amg_c_get_avg_cr
|
||||
procedure, pass(prec) :: cmp_avg_cr => amg_c_cmp_avg_cr
|
||||
procedure, pass(prec) :: set_nlevs => amg_c_set_nlevs
|
||||
procedure, pass(prec) :: get_nlevs => amg_c_get_nlevs
|
||||
procedure, pass(prec) :: get_nzeros => amg_c_get_nzeros
|
||||
procedure, pass(prec) :: sizeof => amg_cprec_sizeof
|
||||
@@ -311,7 +313,7 @@ module amg_c_prec_type
|
||||
& psb_c_base_sparse_mat, psb_c_base_vect_type, &
|
||||
& psb_i_base_vect_type, amg_cprec_type, psb_ipk_
|
||||
implicit none
|
||||
type(psb_cspmat_type), intent(in), target :: a
|
||||
type(psb_cspmat_type), intent(inout), target :: a
|
||||
type(psb_desc_type), intent(inout), target :: desc_a
|
||||
class(amg_cprec_type), intent(inout), target :: prec
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
@@ -323,14 +325,15 @@ module amg_c_prec_type
|
||||
end interface amg_precbld
|
||||
|
||||
interface amg_hierarchy_bld
|
||||
subroutine amg_c_hierarchy_bld(a,desc_a,prec,info)
|
||||
subroutine amg_c_hierarchy_bld(a,desc_a,prec,info,cpymat)
|
||||
import :: psb_cspmat_type, psb_desc_type, psb_spk_, &
|
||||
& amg_cprec_type, psb_ipk_
|
||||
implicit none
|
||||
type(psb_cspmat_type), intent(in), target :: a
|
||||
type(psb_cspmat_type), intent(inout), target :: a
|
||||
type(psb_desc_type), intent(inout), target :: desc_a
|
||||
class(amg_cprec_type), intent(inout), target :: prec
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
logical, intent(in), optional :: cpymat
|
||||
! character, intent(in),optional :: upd
|
||||
end subroutine amg_c_hierarchy_bld
|
||||
end interface amg_hierarchy_bld
|
||||
@@ -434,10 +437,19 @@ contains
|
||||
class(amg_cprec_type), intent(in) :: prec
|
||||
integer(psb_ipk_) :: val
|
||||
val = 0
|
||||
if (allocated(prec%precv)) then
|
||||
val = size(prec%precv)
|
||||
end if
|
||||
!!$ if (allocated(prec%precv)) then
|
||||
!!$ val = size(prec%precv)
|
||||
!!$ end if
|
||||
val = prec%nlevs
|
||||
!!$ write(0,*) ' NLEVS: ',prec%nlevs, val,size(prec%precv)
|
||||
end function amg_c_get_nlevs
|
||||
|
||||
subroutine amg_c_set_nlevs(prec,nl)
|
||||
implicit none
|
||||
class(amg_cprec_type), intent(inout) :: prec
|
||||
integer(psb_ipk_) :: nl
|
||||
prec%nlevs = nl
|
||||
end subroutine amg_c_set_nlevs
|
||||
!
|
||||
! Function returning the size of the amg_prec_type data structure
|
||||
! in bytes or in number of nonzeros of the operator(s) involved.
|
||||
@@ -508,7 +520,7 @@ contains
|
||||
|
||||
real(psb_spk_) :: num, den, nmin
|
||||
type(psb_ctxt_type) :: ctxt
|
||||
integer(psb_ipk_) :: il
|
||||
integer(psb_ipk_) :: il,nl
|
||||
|
||||
num = -sone
|
||||
den = sone
|
||||
@@ -518,7 +530,10 @@ contains
|
||||
num = prec%precv(il)%base_a%get_nzeros()
|
||||
if (num >= szero) then
|
||||
den = num
|
||||
do il=2,size(prec%precv)
|
||||
nl = prec%get_nlevs()
|
||||
!!$ write(0,*) 'Inside cmp_compl ',nl,size(prec%precv)
|
||||
do il=2, nl
|
||||
!!$ write(0,*) ' ',il,associated(prec%precv(il)%base_a)
|
||||
num = num + max(0,prec%precv(il)%base_a%get_nzeros())
|
||||
end do
|
||||
end if
|
||||
@@ -549,7 +564,6 @@ contains
|
||||
end function amg_c_get_avg_cr
|
||||
|
||||
subroutine amg_c_cmp_avg_cr(prec)
|
||||
|
||||
implicit none
|
||||
class(amg_cprec_type), intent(inout) :: prec
|
||||
|
||||
@@ -557,17 +571,18 @@ contains
|
||||
type(psb_ctxt_type) :: ctxt
|
||||
integer(psb_ipk_) :: il, nl, iam, np
|
||||
|
||||
|
||||
avgcr = szero
|
||||
nl = prec%get_nlevs()
|
||||
do il=2,nl
|
||||
if (prec%precv(il)%base_desc%is_ok()) then
|
||||
ctxt = prec%precv(il)%base_desc%get_ctxt()
|
||||
call psb_info(ctxt,iam,np)
|
||||
if (iam >=0) avgcr = avgcr + max(szero,prec%precv(il)%szratio)
|
||||
end if
|
||||
end do
|
||||
avgcr = avgcr / (nl-1)
|
||||
ctxt = prec%ctxt
|
||||
call psb_info(ctxt,iam,np)
|
||||
if (allocated(prec%precv)) then
|
||||
nl = size(prec%precv)
|
||||
do il=2,nl
|
||||
avgcr = avgcr + max(szero,prec%precv(il)%szratio)
|
||||
end do
|
||||
avgcr = avgcr / (nl-1)
|
||||
end if
|
||||
call psb_sum(ctxt,avgcr)
|
||||
prec%ag_data%avg_cr = avgcr/np
|
||||
end subroutine amg_c_cmp_avg_cr
|
||||
@@ -585,9 +600,7 @@ contains
|
||||
! error code.
|
||||
!
|
||||
subroutine amg_cprecfree(p,info)
|
||||
|
||||
implicit none
|
||||
|
||||
! Arguments
|
||||
type(amg_cprec_type), intent(inout) :: p
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
@@ -613,9 +626,7 @@ contains
|
||||
end subroutine amg_cprecfree
|
||||
|
||||
subroutine amg_c_prec_free(prec,info)
|
||||
|
||||
implicit none
|
||||
|
||||
! Arguments
|
||||
class(amg_cprec_type), intent(inout) :: prec
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
@@ -647,9 +658,7 @@ contains
|
||||
end subroutine amg_c_prec_free
|
||||
|
||||
subroutine amg_c_smoothers_free(prec,info)
|
||||
|
||||
implicit none
|
||||
|
||||
! Arguments
|
||||
class(amg_cprec_type), intent(inout) :: prec
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
@@ -666,7 +675,7 @@ contains
|
||||
end if
|
||||
|
||||
if (allocated(prec%precv)) then
|
||||
do i=1,size(prec%precv)
|
||||
do i=1,prec%get_nlevs()
|
||||
call prec%precv(i)%free_smoothers(info)
|
||||
end do
|
||||
end if
|
||||
@@ -680,9 +689,7 @@ contains
|
||||
end subroutine amg_c_smoothers_free
|
||||
|
||||
subroutine amg_c_hierarchy_free(prec,info)
|
||||
|
||||
implicit none
|
||||
|
||||
! Arguments
|
||||
class(amg_cprec_type), intent(inout) :: prec
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
@@ -709,7 +716,6 @@ contains
|
||||
|
||||
end subroutine amg_c_hierarchy_free
|
||||
|
||||
|
||||
!
|
||||
! Top level methods.
|
||||
!
|
||||
@@ -774,7 +780,6 @@ contains
|
||||
|
||||
end subroutine amg_c_apply1_vect
|
||||
|
||||
|
||||
subroutine amg_c_apply2v(prec,x,y,desc_data,info,trans,work)
|
||||
implicit none
|
||||
type(psb_desc_type),intent(in) :: desc_data
|
||||
@@ -839,7 +844,6 @@ contains
|
||||
subroutine amg_c_dump(prec,info,istart,iend,iproc,prefix,head,&
|
||||
& ac,rp,smoother,solver,tprol,&
|
||||
& global_num)
|
||||
|
||||
implicit none
|
||||
class(amg_cprec_type), intent(in) :: prec
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
@@ -856,7 +860,7 @@ contains
|
||||
info = 0
|
||||
ctxt = prec%ctxt
|
||||
call psb_info(ctxt,iam,np)
|
||||
iln = size(prec%precv)
|
||||
iln = prec%get_nlevs()
|
||||
if (present(istart)) then
|
||||
il1 = max(1,istart)
|
||||
else
|
||||
@@ -880,7 +884,6 @@ contains
|
||||
end subroutine amg_c_dump
|
||||
|
||||
subroutine amg_c_cnv(prec,info,amold,vmold,imold)
|
||||
|
||||
implicit none
|
||||
class(amg_cprec_type), intent(inout) :: prec
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
@@ -892,7 +895,7 @@ contains
|
||||
|
||||
info = psb_success_
|
||||
if (allocated(prec%precv)) then
|
||||
do i=1,size(prec%precv)
|
||||
do i=1,prec%get_nlevs()
|
||||
if (info == psb_success_ ) &
|
||||
& call prec%precv(i)%cnv(info,amold=amold,vmold=vmold,imold=imold)
|
||||
end do
|
||||
@@ -901,7 +904,6 @@ contains
|
||||
end subroutine amg_c_cnv
|
||||
|
||||
subroutine amg_c_clone(prec,precout,info)
|
||||
|
||||
implicit none
|
||||
class(amg_cprec_type), intent(inout) :: prec
|
||||
class(psb_cprec_type), intent(inout) :: precout
|
||||
@@ -913,7 +915,6 @@ contains
|
||||
end subroutine amg_c_clone
|
||||
|
||||
subroutine amg_c_inner_clone(prec,precout,info)
|
||||
|
||||
implicit none
|
||||
class(amg_cprec_type), intent(inout) :: prec
|
||||
class(psb_cprec_type), target, intent(inout) :: precout
|
||||
@@ -929,8 +930,9 @@ contains
|
||||
pout%ctxt = prec%ctxt
|
||||
pout%ag_data = prec%ag_data
|
||||
pout%outer_sweeps = prec%outer_sweeps
|
||||
pout%nlevs = prec%nlevs
|
||||
if (allocated(prec%precv)) then
|
||||
ln = size(prec%precv)
|
||||
ln = prec%get_nlevs()
|
||||
allocate(pout%precv(ln),stat=info)
|
||||
if (info /= psb_success_) goto 9999
|
||||
if (ln >= 1) then
|
||||
@@ -938,6 +940,7 @@ contains
|
||||
end if
|
||||
do lev=2, ln
|
||||
if (info /= psb_success_) exit
|
||||
!!$ write(0,*) 'Inner_clone must be checked and reimplemented! '
|
||||
call prec%precv(lev)%clone(pout%precv(lev),info)
|
||||
if (info == psb_success_) then
|
||||
pout%precv(lev)%base_a => pout%precv(lev)%ac
|
||||
@@ -1002,7 +1005,7 @@ contains
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
class(psb_c_base_vect_type), intent(in), optional :: vmold
|
||||
!
|
||||
! In MLD the DESC optional argument is ignored, since
|
||||
! In AMG the DESC optional argument is ignored, since
|
||||
! the necessary info is contained in the various entries of the
|
||||
! PRECV component.
|
||||
type(psb_desc_type), intent(in), optional :: desc
|
||||
@@ -1017,7 +1020,7 @@ contains
|
||||
if (psb_errstatus_fatal()) then
|
||||
info = psb_err_internal_error_; goto 9999
|
||||
end if
|
||||
nlev = size(prec%precv)
|
||||
nlev = prec%get_nlevs()
|
||||
level = 1
|
||||
do level = 1, nlev
|
||||
call prec%precv(level)%allocate_wrk(info,vmold=vmold)
|
||||
@@ -1040,7 +1043,6 @@ contains
|
||||
subroutine amg_c_free_wrk(prec,info)
|
||||
use psb_base_mod
|
||||
implicit none
|
||||
|
||||
! Arguments
|
||||
class(amg_cprec_type), intent(inout) :: prec
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
@@ -1057,7 +1059,7 @@ contains
|
||||
end if
|
||||
|
||||
if (allocated(prec%precv)) then
|
||||
nlev = size(prec%precv)
|
||||
nlev = prec%get_nlevs()
|
||||
do level = 1, nlev
|
||||
call prec%precv(level)%free_wrk(info)
|
||||
end do
|
||||
|
||||
+262
-206
@@ -20,7 +20,7 @@
|
||||
! documentation and/or other materials provided with the distribution.
|
||||
! 3. The name of the AMG4PSBLAS group or the names of its contributors may
|
||||
! not be used to endorse or promote products derived from this
|
||||
! software without specific written permission.
|
||||
! software without specific prior written permission.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
@@ -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(inout), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_c_slu_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
type(psb_cspmat_type), intent(in), target, optional :: b
|
||||
class(psb_c_base_sparse_mat), intent(in), optional :: amold
|
||||
class(psb_c_base_vect_type), intent(in), optional :: vmold
|
||||
class(psb_i_base_vect_type), intent(in), optional :: imold
|
||||
end subroutine amg_c_slu_solver_bld
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_c_slu_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
|
||||
& trans,work,wv,info,init,initu)
|
||||
use psb_base_mod
|
||||
import amg_c_slu_solver_type
|
||||
implicit none
|
||||
type(psb_desc_type), intent(in) :: desc_data
|
||||
class(amg_c_slu_solver_type), intent(inout) :: sv
|
||||
type(psb_c_vect_type),intent(inout) :: x
|
||||
type(psb_c_vect_type),intent(inout) :: y
|
||||
complex(psb_spk_),intent(in) :: alpha,beta
|
||||
character(len=1),intent(in) :: trans
|
||||
complex(psb_spk_),target, intent(inout) :: work(:)
|
||||
type(psb_c_vect_type),intent(inout) :: wv(:)
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character, intent(in), optional :: init
|
||||
type(psb_c_vect_type),intent(inout), optional :: initu
|
||||
end subroutine amg_c_slu_solver_apply_vect
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_c_slu_solver_apply(alpha,sv,x,beta,y,desc_data,&
|
||||
& trans,work,info,init,initu)
|
||||
use psb_base_mod
|
||||
import amg_c_slu_solver_type
|
||||
implicit none
|
||||
type(psb_desc_type), intent(in) :: desc_data
|
||||
class(amg_c_slu_solver_type), intent(inout) :: sv
|
||||
complex(psb_spk_),intent(inout) :: x(:)
|
||||
complex(psb_spk_),intent(inout) :: y(:)
|
||||
complex(psb_spk_),intent(in) :: alpha,beta
|
||||
character(len=1),intent(in) :: trans
|
||||
complex(psb_spk_),target, intent(inout) :: work(:)
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character, intent(in), optional :: init
|
||||
complex(psb_spk_),intent(inout), optional :: initu(:)
|
||||
end subroutine amg_c_slu_solver_apply
|
||||
end interface
|
||||
|
||||
contains
|
||||
|
||||
subroutine c_slu_solver_apply(alpha,sv,x,beta,y,desc_data,&
|
||||
& trans,work,info,init,initu)
|
||||
use psb_base_mod
|
||||
implicit none
|
||||
type(psb_desc_type), intent(in) :: desc_data
|
||||
class(amg_c_slu_solver_type), intent(inout) :: sv
|
||||
complex(psb_spk_),intent(inout) :: x(:)
|
||||
complex(psb_spk_),intent(inout) :: y(:)
|
||||
complex(psb_spk_),intent(in) :: alpha,beta
|
||||
character(len=1),intent(in) :: trans
|
||||
complex(psb_spk_),target, intent(inout) :: work(:)
|
||||
integer, intent(out) :: info
|
||||
character, intent(in), optional :: init
|
||||
complex(psb_spk_),intent(inout), optional :: initu(:)
|
||||
|
||||
integer :: n_row,n_col
|
||||
complex(psb_spk_), pointer :: ww(:)
|
||||
type(psb_ctxt_type) :: ctxt
|
||||
integer :: np,me,i, err_act
|
||||
character :: trans_
|
||||
character(len=20) :: name='c_slu_solver_apply'
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
info = psb_success_
|
||||
|
||||
trans_ = psb_toupper(trans)
|
||||
select case(trans_)
|
||||
case('N')
|
||||
case('T','C')
|
||||
case default
|
||||
call psb_errpush(psb_err_iarg_invalid_i_,name)
|
||||
goto 9999
|
||||
end select
|
||||
!
|
||||
! For non-iterative solvers, init and initu are ignored.
|
||||
!
|
||||
|
||||
n_row = desc_data%get_local_rows()
|
||||
n_col = desc_data%get_local_cols()
|
||||
|
||||
if (n_col <= size(work)) then
|
||||
ww => work(1:n_col)
|
||||
else
|
||||
allocate(ww(n_col),stat=info)
|
||||
if (info /= psb_success_) then
|
||||
info=psb_err_alloc_request_
|
||||
call psb_errpush(info,name,i_err=(/n_col,0,0,0,0/),&
|
||||
& a_err='complex(psb_spk_)')
|
||||
goto 9999
|
||||
end if
|
||||
endif
|
||||
|
||||
ww(1:n_row) = x(1:n_row)
|
||||
select case(trans_)
|
||||
case('N')
|
||||
info = amg_cslu_solve(0,n_row,1,ww,n_row,sv%lufactors)
|
||||
case('T')
|
||||
info = amg_cslu_solve(1,n_row,1,ww,n_row,sv%lufactors)
|
||||
case('C')
|
||||
info = amg_cslu_solve(2,n_row,1,ww,n_row,sv%lufactors)
|
||||
case default
|
||||
call psb_errpush(psb_err_internal_error_, &
|
||||
& name,a_err='Invalid TRANS in ILU subsolve')
|
||||
goto 9999
|
||||
end select
|
||||
|
||||
if (info == psb_success_) &
|
||||
& call psb_geaxpby(alpha,ww,beta,y,desc_data,info)
|
||||
|
||||
|
||||
if (info /= psb_success_) then
|
||||
call psb_errpush(psb_err_internal_error_,&
|
||||
& name,a_err='Error in subsolve')
|
||||
goto 9999
|
||||
endif
|
||||
|
||||
if (n_col > size(work)) then
|
||||
deallocate(ww)
|
||||
endif
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
|
||||
end subroutine c_slu_solver_apply
|
||||
|
||||
subroutine c_slu_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
|
||||
& trans,work,wv,info,init,initu)
|
||||
use psb_base_mod
|
||||
implicit none
|
||||
type(psb_desc_type), intent(in) :: desc_data
|
||||
class(amg_c_slu_solver_type), intent(inout) :: sv
|
||||
type(psb_c_vect_type),intent(inout) :: x
|
||||
type(psb_c_vect_type),intent(inout) :: y
|
||||
complex(psb_spk_),intent(in) :: alpha,beta
|
||||
character(len=1),intent(in) :: trans
|
||||
complex(psb_spk_),target, intent(inout) :: work(:)
|
||||
type(psb_c_vect_type),intent(inout) :: wv(:)
|
||||
integer, intent(out) :: info
|
||||
character, intent(in), optional :: init
|
||||
type(psb_c_vect_type),intent(inout), optional :: initu
|
||||
|
||||
integer :: err_act
|
||||
character(len=20) :: name='c_slu_solver_apply_vect'
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
info = psb_success_
|
||||
!
|
||||
! For non-iterative solvers, init and initu are ignored.
|
||||
!
|
||||
|
||||
call x%v%sync()
|
||||
call y%v%sync()
|
||||
call sv%apply(alpha,x%v%v,beta,y%v%v,desc_data,trans,work,info)
|
||||
call y%v%set_host()
|
||||
if (info /= 0) goto 9999
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
|
||||
end subroutine c_slu_solver_apply_vect
|
||||
|
||||
subroutine c_slu_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
|
||||
|
||||
use psb_base_mod
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
type(psb_cspmat_type), intent(in), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_c_slu_solver_type), intent(inout) :: sv
|
||||
integer, intent(out) :: info
|
||||
type(psb_cspmat_type), intent(in), target, optional :: b
|
||||
class(psb_c_base_sparse_mat), intent(in), optional :: amold
|
||||
class(psb_c_base_vect_type), intent(in), optional :: vmold
|
||||
class(psb_i_base_vect_type), intent(in), optional :: imold
|
||||
! Local variables
|
||||
type(psb_cspmat_type) :: atmp
|
||||
type(psb_c_csc_sparse_mat) :: acsc
|
||||
type(psb_c_coo_sparse_mat) :: acoo
|
||||
integer :: n_row,n_col, nrow_a, nztota
|
||||
type(psb_ctxt_type) :: ctxt
|
||||
integer :: np,me,i, err_act, debug_unit, debug_level
|
||||
character(len=20) :: name='c_slu_solver_bld', ch_err
|
||||
|
||||
info=psb_success_
|
||||
call psb_erractionsave(err_act)
|
||||
debug_unit = psb_get_debug_unit()
|
||||
debug_level = psb_get_debug_level()
|
||||
ctxt = desc_a%get_context()
|
||||
call psb_info(ctxt, me, np)
|
||||
if (debug_level >= psb_debug_outer_) &
|
||||
& write(debug_unit,*) me,' ',trim(name),' start'
|
||||
|
||||
|
||||
n_row = desc_a%get_local_rows()
|
||||
n_col = desc_a%get_local_cols()
|
||||
|
||||
|
||||
call a%cscnv(atmp,info,type='coo')
|
||||
call psb_rwextd(n_row,atmp,info,b=b)
|
||||
call atmp%cscnv(info,type='coo',dupl=psb_dupl_add_)
|
||||
nrow_a = atmp%get_nrows()
|
||||
call atmp%a%csclip(acoo,info,jmax=nrow_a)
|
||||
call acsc%mv_from_coo(acoo,info)
|
||||
nztota = acsc%get_nzeros()
|
||||
! Fix the entries to call C-base SuperLU
|
||||
acsc%ia(:) = acsc%ia(:) - 1
|
||||
acsc%icp(:) = acsc%icp(:) - 1
|
||||
info = amg_cslu_fact(nrow_a,nztota,acsc%val,&
|
||||
& acsc%icp,acsc%ia,sv%lufactors)
|
||||
|
||||
if (info /= psb_success_) then
|
||||
info=psb_err_from_subroutine_
|
||||
ch_err='amg_cslu_fact'
|
||||
call psb_errpush(info,name,a_err=ch_err)
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
call acsc%free()
|
||||
call atmp%free()
|
||||
|
||||
if (debug_level >= psb_debug_outer_) &
|
||||
& write(debug_unit,*) me,' ',trim(name),' end'
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
end subroutine c_slu_solver_bld
|
||||
!!$ subroutine c_slu_solver_apply(alpha,sv,x,beta,y,desc_data,&
|
||||
!!$ & trans,work,info,init,initu)
|
||||
!!$ use psb_base_mod
|
||||
!!$ implicit none
|
||||
!!$ type(psb_desc_type), intent(in) :: desc_data
|
||||
!!$ class(amg_c_slu_solver_type), intent(inout) :: sv
|
||||
!!$ complex(psb_spk_),intent(inout) :: x(:)
|
||||
!!$ complex(psb_spk_),intent(inout) :: y(:)
|
||||
!!$ complex(psb_spk_),intent(in) :: alpha,beta
|
||||
!!$ character(len=1),intent(in) :: trans
|
||||
!!$ complex(psb_spk_),target, intent(inout) :: work(:)
|
||||
!!$ integer, intent(out) :: info
|
||||
!!$ character, intent(in), optional :: init
|
||||
!!$ complex(psb_spk_),intent(inout), optional :: initu(:)
|
||||
!!$
|
||||
!!$ integer :: n_row,n_col
|
||||
!!$ complex(psb_spk_), pointer :: ww(:)
|
||||
!!$ type(psb_ctxt_type) :: ctxt
|
||||
!!$ integer :: np,me,i, err_act
|
||||
!!$ character :: trans_
|
||||
!!$ character(len=20) :: name='c_slu_solver_apply'
|
||||
!!$
|
||||
!!$ call psb_erractionsave(err_act)
|
||||
!!$
|
||||
!!$ info = psb_success_
|
||||
!!$
|
||||
!!$ trans_ = psb_toupper(trans)
|
||||
!!$ select case(trans_)
|
||||
!!$ case('N')
|
||||
!!$ case('T','C')
|
||||
!!$ case default
|
||||
!!$ call psb_errpush(psb_err_iarg_invalid_i_,name)
|
||||
!!$ goto 9999
|
||||
!!$ end select
|
||||
!!$ !
|
||||
!!$ ! For non-iterative solvers, init and initu are ignored.
|
||||
!!$ !
|
||||
!!$
|
||||
!!$ n_row = desc_data%get_local_rows()
|
||||
!!$ n_col = desc_data%get_local_cols()
|
||||
!!$
|
||||
!!$ if (n_col <= size(work)) then
|
||||
!!$ ww => work(1:n_col)
|
||||
!!$ else
|
||||
!!$ allocate(ww(n_col),stat=info)
|
||||
!!$ if (info /= psb_success_) then
|
||||
!!$ info=psb_err_alloc_request_
|
||||
!!$ call psb_errpush(info,name,i_err=(/n_col,0,0,0,0/),&
|
||||
!!$ & a_err='complex(psb_spk_)')
|
||||
!!$ goto 9999
|
||||
!!$ end if
|
||||
!!$ endif
|
||||
!!$
|
||||
!!$ ww(1:n_row) = x(1:n_row)
|
||||
!!$ select case(trans_)
|
||||
!!$ case('N')
|
||||
!!$ info = amg_cslu_solve(0,n_row,1,ww,n_row,sv%lufactors)
|
||||
!!$ case('T')
|
||||
!!$ info = amg_cslu_solve(1,n_row,1,ww,n_row,sv%lufactors)
|
||||
!!$ case('C')
|
||||
!!$ info = amg_cslu_solve(2,n_row,1,ww,n_row,sv%lufactors)
|
||||
!!$ case default
|
||||
!!$ call psb_errpush(psb_err_internal_error_, &
|
||||
!!$ & name,a_err='Invalid TRANS in ILU subsolve')
|
||||
!!$ goto 9999
|
||||
!!$ end select
|
||||
!!$
|
||||
!!$ if (info == psb_success_) &
|
||||
!!$ & call psb_geaxpby(alpha,ww,beta,y,desc_data,info)
|
||||
!!$
|
||||
!!$
|
||||
!!$ if (info /= psb_success_) then
|
||||
!!$ call psb_errpush(psb_err_internal_error_,&
|
||||
!!$ & name,a_err='Error in subsolve')
|
||||
!!$ goto 9999
|
||||
!!$ endif
|
||||
!!$
|
||||
!!$ if (n_col > size(work)) then
|
||||
!!$ deallocate(ww)
|
||||
!!$ endif
|
||||
!!$
|
||||
!!$ call psb_erractionrestore(err_act)
|
||||
!!$ return
|
||||
!!$
|
||||
!!$9999 call psb_error_handler(err_act)
|
||||
!!$ return
|
||||
!!$
|
||||
!!$ end subroutine c_slu_solver_apply
|
||||
!!$
|
||||
!!$ subroutine c_slu_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
|
||||
!!$ & trans,work,wv,info,init,initu)
|
||||
!!$ use psb_base_mod
|
||||
!!$ implicit none
|
||||
!!$ type(psb_desc_type), intent(in) :: desc_data
|
||||
!!$ class(amg_c_slu_solver_type), intent(inout) :: sv
|
||||
!!$ type(psb_c_vect_type),intent(inout) :: x
|
||||
!!$ type(psb_c_vect_type),intent(inout) :: y
|
||||
!!$ complex(psb_spk_),intent(in) :: alpha,beta
|
||||
!!$ character(len=1),intent(in) :: trans
|
||||
!!$ complex(psb_spk_),target, intent(inout) :: work(:)
|
||||
!!$ type(psb_c_vect_type),intent(inout) :: wv(:)
|
||||
!!$ integer, intent(out) :: info
|
||||
!!$ character, intent(in), optional :: init
|
||||
!!$ type(psb_c_vect_type),intent(inout), optional :: initu
|
||||
!!$
|
||||
!!$ integer :: err_act
|
||||
!!$ character(len=20) :: name='c_slu_solver_apply_vect'
|
||||
!!$
|
||||
!!$ call psb_erractionsave(err_act)
|
||||
!!$
|
||||
!!$ info = psb_success_
|
||||
!!$ !
|
||||
!!$ ! For non-iterative solvers, init and initu are ignored.
|
||||
!!$ !
|
||||
!!$
|
||||
!!$ call x%v%sync()
|
||||
!!$ call y%v%sync()
|
||||
!!$ call sv%apply(alpha,x%v%v,beta,y%v%v,desc_data,trans,work,info)
|
||||
!!$ call y%v%set_host()
|
||||
!!$ if (info /= 0) goto 9999
|
||||
!!$
|
||||
!!$ call psb_erractionrestore(err_act)
|
||||
!!$ return
|
||||
!!$
|
||||
!!$9999 call psb_error_handler(err_act)
|
||||
!!$ return
|
||||
!!$
|
||||
!!$ end subroutine c_slu_solver_apply_vect
|
||||
!!$
|
||||
!!$ subroutine c_slu_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
|
||||
!!$
|
||||
!!$ use psb_base_mod
|
||||
!!$
|
||||
!!$ Implicit None
|
||||
!!$
|
||||
!!$ ! Arguments
|
||||
!!$ type(psb_cspmat_type), intent(in), target :: a
|
||||
!!$ Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
!!$ class(amg_c_slu_solver_type), intent(inout) :: sv
|
||||
!!$ integer, intent(out) :: info
|
||||
!!$ type(psb_cspmat_type), intent(in), target, optional :: b
|
||||
!!$ class(psb_c_base_sparse_mat), intent(in), optional :: amold
|
||||
!!$ class(psb_c_base_vect_type), intent(in), optional :: vmold
|
||||
!!$ class(psb_i_base_vect_type), intent(in), optional :: imold
|
||||
!!$ ! Local variables
|
||||
!!$ type(psb_cspmat_type) :: atmp
|
||||
!!$ type(psb_c_csc_sparse_mat) :: acsc
|
||||
!!$ type(psb_c_coo_sparse_mat) :: acoo
|
||||
!!$ integer :: n_row,n_col, nrow_a, nztota
|
||||
!!$ type(psb_ctxt_type) :: ctxt
|
||||
!!$ integer :: np,me,i, err_act, debug_unit, debug_level
|
||||
!!$ character(len=20) :: name='c_slu_solver_bld', ch_err
|
||||
!!$
|
||||
!!$ info=psb_success_
|
||||
!!$ call psb_erractionsave(err_act)
|
||||
!!$ debug_unit = psb_get_debug_unit()
|
||||
!!$ debug_level = psb_get_debug_level()
|
||||
!!$ ctxt = desc_a%get_context()
|
||||
!!$ call psb_info(ctxt, me, np)
|
||||
!!$ if (debug_level >= psb_debug_outer_) &
|
||||
!!$ & write(debug_unit,*) me,' ',trim(name),' start'
|
||||
!!$
|
||||
!!$
|
||||
!!$ n_row = desc_a%get_local_rows()
|
||||
!!$ n_col = desc_a%get_local_cols()
|
||||
!!$
|
||||
!!$
|
||||
!!$ call a%cscnv(atmp,info,type='coo')
|
||||
!!$ call psb_rwextd(n_row,atmp,info,b=b)
|
||||
!!$ call atmp%cscnv(info,type='coo',dupl=psb_dupl_add_)
|
||||
!!$ nrow_a = atmp%get_nrows()
|
||||
!!$ call atmp%a%csclip(acoo,info,jmax=nrow_a)
|
||||
!!$ call acsc%mv_from_coo(acoo,info)
|
||||
!!$ nztota = acsc%get_nzeros()
|
||||
!!$ ! Fix the entries to call C-base SuperLU
|
||||
!!$ acsc%ia(:) = acsc%ia(:) - 1
|
||||
!!$ acsc%icp(:) = acsc%icp(:) - 1
|
||||
!!$ info = amg_cslu_fact(nrow_a,nztota,acsc%val,&
|
||||
!!$ & acsc%icp,acsc%ia,sv%lufactors)
|
||||
!!$
|
||||
!!$ if (info /= psb_success_) then
|
||||
!!$ info=psb_err_from_subroutine_
|
||||
!!$ ch_err='amg_cslu_fact'
|
||||
!!$ call psb_errpush(info,name,a_err=ch_err)
|
||||
!!$ goto 9999
|
||||
!!$ end if
|
||||
!!$
|
||||
!!$ call acsc%free()
|
||||
!!$ call atmp%free()
|
||||
!!$
|
||||
!!$ if (debug_level >= psb_debug_outer_) &
|
||||
!!$ & write(debug_unit,*) me,' ',trim(name),' end'
|
||||
!!$
|
||||
!!$ call psb_erractionrestore(err_act)
|
||||
!!$ return
|
||||
!!$
|
||||
!!$9999 call psb_error_handler(err_act)
|
||||
!!$ return
|
||||
!!$ end subroutine c_slu_solver_bld
|
||||
|
||||
subroutine c_slu_solver_free(sv,info)
|
||||
|
||||
|
||||
@@ -20,7 +20,7 @@
|
||||
! documentation and/or other materials provided with the distribution.
|
||||
! 3. The name of the AMG4PSBLAS group or the names of its contributors may
|
||||
! not be used to endorse or promote products derived from this
|
||||
! software without specific written permission.
|
||||
! software without specific prior written permission.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
|
||||
@@ -3,6 +3,12 @@
|
||||
|
||||
#include "psb_config.h"
|
||||
|
||||
#define AMG_VERSION_MAJOR @AMGMAJOR@
|
||||
#define AMG_VERSION_MINOR @AMGMINOR@
|
||||
#define AMG_VERSION_PATCHLEVEL @AMGPATCH@
|
||||
#define AMG_VERSION_STRING @AMGSTRING@
|
||||
|
||||
|
||||
@CHAVEUMF@
|
||||
@CHAVESLU@
|
||||
@CSLUVERSION@
|
||||
|
||||
@@ -1,107 +0,0 @@
|
||||
/* This file was generated by a script using the mld_base_prec_type.F90 file as a basis. */
|
||||
#ifndef MLD_CONST_H_
|
||||
#define MLD_CONST_H_
|
||||
#ifdef __cplusplus
|
||||
extern "C" {
|
||||
#endif
|
||||
#define MLD_VERSION_STRING_ ( "2.0.0" )
|
||||
#define MLD_VERSION_MAJOR_ ( 2 )
|
||||
#define MLD_VERSION_MINOR_ ( 0 )
|
||||
#define MLD_PATCHLEVEL_ ( 0 )
|
||||
#define MLD_SMOOTHER_TYPE_ ( 1 )
|
||||
#define MLD_SUB_SOLVE_ ( 2 )
|
||||
#define MLD_SUB_RESTR_ ( 3 )
|
||||
#define MLD_SUB_PROL_ ( 4 )
|
||||
#define MLD_SUB_REN_ ( 5 )
|
||||
#define MLD_SUB_OVR_ ( 6 )
|
||||
#define MLD_SUB_FILLIN_ ( 8 )
|
||||
#define MLD_SLU_PTR_ ( 10 )
|
||||
#define MLD_UMF_SYMPTR_ ( 12 )
|
||||
#define MLD_UMF_NUMPTR_ ( 14 )
|
||||
#define MLD_SLUD_PTR_ ( 16 )
|
||||
#define MLD_PREC_STATUS_ ( 18 )
|
||||
#define MLD_ML_TYPE_ ( 20 )
|
||||
#define MLD_SMOOTHER_SWEEPS_PRE_ ( 21 )
|
||||
#define MLD_SMOOTHER_SWEEPS_POST_ ( 22 )
|
||||
#define MLD_SMOOTHER_POS_ ( 23 )
|
||||
#define MLD_AGGR_KIND_ ( 24 )
|
||||
#define MLD_AGGR_ALG_ ( 25 )
|
||||
#define MLD_AGGR_OMEGA_ALG_ ( 26 )
|
||||
#define MLD_AGGR_EIG_ ( 27 )
|
||||
#define MLD_AGGR_FILTER_ ( 28 )
|
||||
#define MLD_COARSE_MAT_ ( 29 )
|
||||
#define MLD_COARSE_SOLVE_ ( 30 )
|
||||
#define MLD_COARSE_SWEEPS_ ( 31 )
|
||||
#define MLD_COARSE_FILLIN_ ( 32 )
|
||||
#define MLD_COARSE_SUBSOLVE_ ( 33 )
|
||||
#define MLD_SMOOTHER_SWEEPS_ ( 34 )
|
||||
#define MLD_IFPSZ_ ( 36 )
|
||||
#define MLD_MIN_PREC_ ( 0 )
|
||||
#define MLD_NOPREC_ ( 0 )
|
||||
#define MLD_JAC_ ( 1 )
|
||||
#define MLD_BJAC_ ( 2 )
|
||||
#define MLD_AS_ ( 3 )
|
||||
#define MLD_MAX_PREC_ ( 3 )
|
||||
#define MLD_SLV_DELTA_ ( MLD_MAX_PREC_+1 )
|
||||
#define MLD_F_NONE_ ( MLD_SLV_DELTA_+0 )
|
||||
#define MLD_DIAG_SCALE_ ( MLD_SLV_DELTA_+1 )
|
||||
#define MLD_ILU_N_ ( MLD_SLV_DELTA_+2 )
|
||||
#define MLD_MILU_N_ ( MLD_SLV_DELTA_+3 )
|
||||
#define MLD_ILU_T_ ( MLD_SLV_DELTA_+4 )
|
||||
#define MLD_SLU_ ( MLD_SLV_DELTA_+5 )
|
||||
#define MLD_UMF_ ( MLD_SLV_DELTA_+6 )
|
||||
#define MLD_SLUDIST_ ( MLD_SLV_DELTA_+7 )
|
||||
#define MLD_MAX_SUB_SOLVE_ ( MLD_SLV_DELTA_+7 )
|
||||
#define MLD_MIN_SUB_SOLVE_ ( MLD_DIAG_SCALE_ )
|
||||
#define MLD_RENUM_NONE_ (0 )
|
||||
#define MLD_RENUM_GLB_ (1 )
|
||||
#define MLD_RENUM_GPS_ (2 )
|
||||
#define MLD_MAX_RENUM_ (1 )
|
||||
#define MLD_NO_ML_ ( 0 )
|
||||
#define MLD_ADD_ML_ ( 1 )
|
||||
#define MLD_MULT_ML_ ( 2 )
|
||||
#define MLD_NEW_ML_PREC_ ( 3 )
|
||||
#define MLD_MAX_ML_TYPE_ ( MLD_MULT_ML_ )
|
||||
#define MLD_PRE_SMOOTH_ (1 )
|
||||
#define MLD_POST_SMOOTH_ (2 )
|
||||
#define MLD_TWOSIDE_SMOOTH_ (3 )
|
||||
#define MLD_MAX_SMOOTH_ (MLD_TWOSIDE_SMOOTH_ )
|
||||
#define MLD_NO_SMOOTH_ ( 0 )
|
||||
#define MLD_SMOOTH_PROL_ ( 1 )
|
||||
#define MLD_MIN_ENERGY_ ( 2 )
|
||||
#define MLD_BIZ_PROL_ ( 3 )
|
||||
#define MLD_MAX_AGGR_KIND_ (MLD_MIN_ENERGY_ )
|
||||
#define MLD_NO_FILTER_MAT_ (0 )
|
||||
#define MLD_FILTER_MAT_ (1 )
|
||||
#define MLD_MAX_FILTER_MAT_ (MLD_NO_FILTER_MAT_ )
|
||||
#define MLD_DEC_AGGR_ (0 )
|
||||
#define MLD_SYM_DEC_AGGR_ (1 )
|
||||
#define MLD_GLB_AGGR_ (2 )
|
||||
#define MLD_NEW_DEC_AGGR_ (3 )
|
||||
#define MLD_NEW_GLB_AGGR_ (4 )
|
||||
#define MLD_MAX_AGGR_ALG_ (MLD_DEC_AGGR_ )
|
||||
#define MLD_EIG_EST_ (0 )
|
||||
#define MLD_USER_CHOICE_ (999 )
|
||||
#define MLD_MAX_NORM_ (0 )
|
||||
#define MLD_DISTR_MAT_ (0 )
|
||||
#define MLD_REPL_MAT_ (1 )
|
||||
#define MLD_MAX_COARSE_MAT_ (MLD_REPL_MAT_ )
|
||||
#define MLD_PREC_BUILT_ (98765 )
|
||||
#define MLD_SUB_ILUTHRS_ ( 1 )
|
||||
#define MLD_AGGR_OMEGA_VAL_ ( 2 )
|
||||
#define MLD_AGGR_THRESH_ ( 3 )
|
||||
#define MLD_COARSE_ILUTHRS_ ( 4 )
|
||||
#define MLD_RFPSZ_ ( 8 )
|
||||
#define MLD_L_PR_ (1 )
|
||||
#define MLD_U_PR_ (2 )
|
||||
#define MLD_BP_ILU_AVSZ_ (2 )
|
||||
#define MLD_AP_ND_ (3 )
|
||||
#define MLD_AC_ (4 )
|
||||
#define MLD_SM_PR_T_ (5 )
|
||||
#define MLD_SM_PR_ (6 )
|
||||
#define MLD_SMTH_AVSZ_ (6 )
|
||||
#define MLD_MAX_AVSZ_ (MLD_SMTH_AVSZ_ )
|
||||
#ifdef __cplusplus
|
||||
}
|
||||
#endif
|
||||
#endif
|
||||
@@ -20,7 +20,7 @@
|
||||
! documentation and/or other materials provided with the distribution.
|
||||
! 3. The name of the AMG4PSBLAS group or the names of its contributors may
|
||||
! not be used to endorse or promote products derived from this
|
||||
! software without specific written permission.
|
||||
! software without specific prior written permission.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
@@ -103,7 +103,7 @@ module amg_d_ainv_solver
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
type(psb_dspmat_type), intent(in), target :: a
|
||||
type(psb_dspmat_type), intent(inout), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_d_ainv_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
@@ -225,7 +225,7 @@ module amg_d_ainv_solver
|
||||
import :: psb_desc_type, psb_dspmat_type, psb_d_base_sparse_mat, &
|
||||
& psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, psb_ipk_
|
||||
implicit none
|
||||
type(psb_dspmat_type), intent(in), target :: a
|
||||
type(psb_dspmat_type), intent(inout), target :: a
|
||||
integer(psb_ipk_), intent(in) :: fillin,alg
|
||||
real(psb_dpk_), intent(in) :: thresh
|
||||
type(psb_dspmat_type), intent(inout) :: wmat, zmat
|
||||
|
||||
@@ -20,7 +20,7 @@
|
||||
! documentation and/or other materials provided with the distribution.
|
||||
! 3. The name of the AMG4PSBLAS group or the names of its contributors may
|
||||
! not be used to endorse or promote products derived from this
|
||||
! software without specific written permission.
|
||||
! software without specific prior written permission.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
@@ -230,7 +230,7 @@ module amg_d_as_smoother
|
||||
& psb_desc_type, psb_d_base_sparse_mat, psb_ipk_,&
|
||||
& psb_i_base_vect_type
|
||||
implicit none
|
||||
type(psb_dspmat_type), intent(in), target :: a
|
||||
type(psb_dspmat_type), intent(inout), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_d_as_smoother_type), intent(inout) :: sm
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
@@ -20,7 +20,7 @@
|
||||
! documentation and/or other materials provided with the distribution.
|
||||
! 3. The name of the AMG4PSBLAS group or the names of its contributors may
|
||||
! not be used to endorse or promote products derived from this
|
||||
! software without specific written permission.
|
||||
! software without specific prior written permission.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
@@ -89,7 +89,7 @@ module amg_d_base_aggregator_mod
|
||||
procedure, pass(ag) :: bld_tprol => amg_d_base_aggregator_build_tprol
|
||||
procedure, pass(ag) :: mat_bld => amg_d_base_aggregator_mat_bld
|
||||
procedure, pass(ag) :: mat_asb => amg_d_base_aggregator_mat_asb
|
||||
procedure, pass(ag) :: bld_map => amg_d_base_aggregator_bld_map
|
||||
procedure, pass(ag) :: bld_linmap => amg_d_base_aggregator_bld_linmap
|
||||
procedure, pass(ag) :: update_next => amg_d_base_aggregator_update_next
|
||||
procedure, pass(ag) :: clone => amg_d_base_aggregator_clone
|
||||
procedure, pass(ag) :: free => amg_d_base_aggregator_free
|
||||
@@ -458,7 +458,7 @@ contains
|
||||
end subroutine amg_d_base_aggregator_mat_asb
|
||||
|
||||
!
|
||||
!> Function bld_map
|
||||
!> Function bld_linmap
|
||||
!! \memberof amg_d_base_aggregator_type
|
||||
!! \brief Build linear map between hierarchy levels
|
||||
!!
|
||||
@@ -473,7 +473,7 @@ contains
|
||||
!! \param map The output map
|
||||
!! \param info Return code
|
||||
!!
|
||||
subroutine amg_d_base_aggregator_bld_map(ag,desc_a,desc_ac,ilaggr,nlaggr,&
|
||||
subroutine amg_d_base_aggregator_bld_linmap(ag,desc_a,desc_ac,ilaggr,nlaggr,&
|
||||
& op_restr,op_prol,map,info)
|
||||
use psb_base_mod
|
||||
implicit none
|
||||
@@ -484,7 +484,7 @@ contains
|
||||
type(psb_dlinmap_type), intent(out) :: map
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20) :: name='d_base_aggregator_bld_map'
|
||||
character(len=20) :: name='d_base_aggregator_bld_linmap'
|
||||
|
||||
info = psb_success_
|
||||
call psb_erractionsave(err_act)
|
||||
@@ -508,7 +508,6 @@ contains
|
||||
9999 call psb_error_handler(err_act)
|
||||
|
||||
return
|
||||
end subroutine amg_d_base_aggregator_bld_map
|
||||
|
||||
end subroutine amg_d_base_aggregator_bld_linmap
|
||||
|
||||
end module amg_d_base_aggregator_mod
|
||||
|
||||
@@ -20,7 +20,7 @@
|
||||
! documentation and/or other materials provided with the distribution.
|
||||
! 3. The name of the AMG4PSBLAS group or the names of its contributors may
|
||||
! not be used to endorse or promote products derived from this
|
||||
! software without specific written permission.
|
||||
! software without specific prior written permission.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
|
||||
@@ -20,7 +20,7 @@
|
||||
! documentation and/or other materials provided with the distribution.
|
||||
! 3. The name of the AMG4PSBLAS group or the names of its contributors may
|
||||
! not be used to endorse or promote products derived from this
|
||||
! software without specific written permission.
|
||||
! software without specific prior written permission.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
@@ -237,7 +237,7 @@ module amg_d_base_smoother_mod
|
||||
& psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, &
|
||||
& amg_d_base_smoother_type, psb_ipk_, psb_i_base_vect_type
|
||||
! Arguments
|
||||
type(psb_dspmat_type), intent(in), target :: a
|
||||
type(psb_dspmat_type), intent(inout), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_d_base_smoother_type), intent(inout) :: sm
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
@@ -20,7 +20,7 @@
|
||||
! documentation and/or other materials provided with the distribution.
|
||||
! 3. The name of the AMG4PSBLAS group or the names of its contributors may
|
||||
! not be used to endorse or promote products derived from this
|
||||
! software without specific written permission.
|
||||
! software without specific prior written permission.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
@@ -170,7 +170,7 @@ module amg_d_base_solver_mod
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
type(psb_dspmat_type), intent(in), target :: a
|
||||
type(psb_dspmat_type), intent(inout), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_d_base_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
@@ -20,7 +20,7 @@
|
||||
! documentation and/or other materials provided with the distribution.
|
||||
! 3. The name of the AMG4PSBLAS group or the names of its contributors may
|
||||
! not be used to endorse or promote products derived from this
|
||||
! software without specific written permission.
|
||||
! software without specific prior written permission.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
|
||||
@@ -20,7 +20,7 @@
|
||||
! documentation and/or other materials provided with the distribution.
|
||||
! 3. The name of the AMG4PSBLAS group or the names of its contributors may
|
||||
! not be used to endorse or promote products derived from this
|
||||
! software without specific written permission.
|
||||
! software without specific prior written permission.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
@@ -119,7 +119,7 @@ module amg_d_diag_solver
|
||||
import :: psb_desc_type, psb_dspmat_type, psb_d_base_sparse_mat, &
|
||||
& psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, &
|
||||
& amg_d_diag_solver_type, psb_ipk_, psb_i_base_vect_type
|
||||
type(psb_dspmat_type), intent(in), target :: a
|
||||
type(psb_dspmat_type), intent(inout), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_d_diag_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
@@ -331,7 +331,7 @@ module amg_d_l1_diag_solver
|
||||
import :: psb_desc_type, psb_dspmat_type, psb_d_base_sparse_mat, &
|
||||
& psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, &
|
||||
& amg_d_l1_diag_solver_type, psb_ipk_, psb_i_base_vect_type
|
||||
type(psb_dspmat_type), intent(in), target :: a
|
||||
type(psb_dspmat_type), intent(inout), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_d_l1_diag_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
@@ -20,7 +20,7 @@
|
||||
! documentation and/or other materials provided with the distribution.
|
||||
! 3. The name of the AMG4PSBLAS group or the names of its contributors may
|
||||
! not be used to endorse or promote products derived from this
|
||||
! software without specific written permission.
|
||||
! software without specific prior written permission.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
@@ -181,7 +181,7 @@ module amg_d_gs_solver
|
||||
& psb_dspmat_type, psb_d_base_sparse_mat, psb_d_base_vect_type,&
|
||||
& psb_ipk_, psb_i_base_vect_type
|
||||
implicit none
|
||||
type(psb_dspmat_type), intent(in), target :: a
|
||||
type(psb_dspmat_type), intent(inout), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_d_gs_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
@@ -195,7 +195,7 @@ module amg_d_gs_solver
|
||||
& psb_dspmat_type, psb_d_base_sparse_mat, psb_d_base_vect_type,&
|
||||
& psb_ipk_, psb_i_base_vect_type
|
||||
implicit none
|
||||
type(psb_dspmat_type), intent(in), target :: a
|
||||
type(psb_dspmat_type), intent(inout), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_d_bwgs_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
@@ -20,7 +20,7 @@
|
||||
! documentation and/or other materials provided with the distribution.
|
||||
! 3. The name of the AMG4PSBLAS group or the names of its contributors may
|
||||
! not be used to endorse or promote products derived from this
|
||||
! software without specific written permission.
|
||||
! software without specific prior written permission.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
@@ -123,7 +123,7 @@ contains
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
type(psb_dspmat_type), intent(in), target :: a
|
||||
type(psb_dspmat_type), intent(inout), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_d_id_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
@@ -20,7 +20,7 @@
|
||||
! documentation and/or other materials provided with the distribution.
|
||||
! 3. The name of the AMG4PSBLAS group or the names of its contributors may
|
||||
! not be used to endorse or promote products derived from this
|
||||
! software without specific written permission.
|
||||
! software without specific prior written permission.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
|
||||
@@ -20,7 +20,7 @@
|
||||
! documentation and/or other materials provided with the distribution.
|
||||
! 3. The name of the AMG4PSBLAS group or the names of its contributors may
|
||||
! not be used to endorse or promote products derived from this
|
||||
! software without specific written permission.
|
||||
! software without specific prior written permission.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
@@ -144,7 +144,7 @@ module amg_d_ilu_solver
|
||||
& psb_dspmat_type, psb_d_base_sparse_mat, psb_d_base_vect_type,&
|
||||
& psb_ipk_, psb_i_base_vect_type
|
||||
implicit none
|
||||
type(psb_dspmat_type), intent(in), target :: a
|
||||
type(psb_dspmat_type), intent(inout), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_d_ilu_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
@@ -20,7 +20,7 @@
|
||||
! documentation and/or other materials provided with the distribution.
|
||||
! 3. The name of the AMG4PSBLAS group or the names of its contributors may
|
||||
! not be used to endorse or promote products derived from this
|
||||
! software without specific written permission.
|
||||
! software without specific prior written permission.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
@@ -56,7 +56,7 @@ module amg_d_inner_mod
|
||||
& psb_dpk_, psb_d_base_sparse_mat, psb_d_base_vect_type, psb_ipk_
|
||||
import :: amg_dprec_type
|
||||
implicit none
|
||||
type(psb_dspmat_type), intent(in), target :: a
|
||||
type(psb_dspmat_type), intent(inout), target :: a
|
||||
type(psb_desc_type), intent(inout), target :: desc_a
|
||||
type(amg_dprec_type), intent(inout), target :: prec
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
@@ -67,7 +67,7 @@ module amg_d_inner_mod
|
||||
end interface amg_mlprec_bld
|
||||
|
||||
interface amg_mlprec_aply
|
||||
subroutine amg_dmlprec_aply(alpha,p,x,beta,y,desc_data,trans,work,info)
|
||||
subroutine amg_dmlprec_aply_a(alpha,p,x,beta,y,desc_data,trans,work,info)
|
||||
import :: psb_dspmat_type, psb_desc_type, psb_dpk_, psb_ipk_
|
||||
import :: amg_dprec_type
|
||||
implicit none
|
||||
@@ -79,7 +79,7 @@ module amg_d_inner_mod
|
||||
character,intent(in) :: trans
|
||||
real(psb_dpk_),target :: work(:)
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine amg_dmlprec_aply
|
||||
end subroutine amg_dmlprec_aply_a
|
||||
subroutine amg_dmlprec_aply_vect(alpha,p,x,beta,y,desc_data,trans,work,info)
|
||||
import :: psb_dspmat_type, psb_desc_type, &
|
||||
& psb_dpk_, psb_d_vect_type, psb_ipk_
|
||||
|
||||
@@ -20,7 +20,7 @@
|
||||
! documentation and/or other materials provided with the distribution.
|
||||
! 3. The name of the AMG4PSBLAS group or the names of its contributors may
|
||||
! not be used to endorse or promote products derived from this
|
||||
! software without specific written permission.
|
||||
! software without specific prior written permission.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
@@ -94,7 +94,7 @@ module amg_d_invk_solver
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
type(psb_dspmat_type), intent(in), target :: a
|
||||
type(psb_dspmat_type), intent(inout), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_d_invk_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
@@ -20,7 +20,7 @@
|
||||
! documentation and/or other materials provided with the distribution.
|
||||
! 3. The name of the AMG4PSBLAS group or the names of its contributors may
|
||||
! not be used to endorse or promote products derived from this
|
||||
! software without specific written permission.
|
||||
! software without specific prior written permission.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
@@ -94,7 +94,7 @@ module amg_d_invt_solver
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
type(psb_dspmat_type), intent(in), target :: a
|
||||
type(psb_dspmat_type), intent(inout), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_d_invt_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
@@ -20,7 +20,7 @@
|
||||
! documentation and/or other materials provided with the distribution.
|
||||
! 3. The name of the AMG4PSBLAS group or the names of its contributors may
|
||||
! not be used to endorse or promote products derived from this
|
||||
! software without specific written permission.
|
||||
! software without specific prior written permission.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
@@ -151,7 +151,7 @@ module amg_d_jac_smoother
|
||||
import :: psb_desc_type, amg_d_jac_smoother_type, psb_d_vect_type, psb_dpk_, &
|
||||
& psb_dspmat_type, psb_d_base_sparse_mat, psb_d_base_vect_type,&
|
||||
& psb_ipk_, psb_i_base_vect_type
|
||||
type(psb_dspmat_type), intent(in), target :: a
|
||||
type(psb_dspmat_type), intent(inout), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_d_jac_smoother_type), intent(inout) :: sm
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
@@ -274,7 +274,7 @@ module amg_d_jac_smoother
|
||||
import :: psb_desc_type, amg_d_l1_jac_smoother_type, psb_d_vect_type, &
|
||||
& psb_dspmat_type, psb_d_base_sparse_mat, psb_d_base_vect_type,&
|
||||
& psb_ipk_, psb_i_base_vect_type
|
||||
type(psb_dspmat_type), intent(in), target :: a
|
||||
type(psb_dspmat_type), intent(inout), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_d_l1_jac_smoother_type), intent(inout) :: sm
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
@@ -20,7 +20,7 @@
|
||||
! documentation and/or other materials provided with the distribution.
|
||||
! 3. The name of the AMG4PSBLAS group or the names of its contributors may
|
||||
! not be used to endorse or promote products derived from this
|
||||
! software without specific written permission.
|
||||
! software without specific prior written permission.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
@@ -143,7 +143,7 @@ module amg_d_jac_solver
|
||||
& psb_dspmat_type, psb_d_base_sparse_mat, psb_d_base_vect_type,&
|
||||
& psb_ipk_, psb_i_base_vect_type
|
||||
implicit none
|
||||
type(psb_dspmat_type), intent(in), target :: a
|
||||
type(psb_dspmat_type), intent(inout), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_d_jac_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
@@ -160,7 +160,7 @@ module amg_d_jac_solver
|
||||
& psb_dspmat_type, psb_d_base_sparse_mat, psb_d_base_vect_type,&
|
||||
& psb_ipk_, psb_i_base_vect_type
|
||||
implicit none
|
||||
type(psb_dspmat_type), intent(in), target :: a
|
||||
type(psb_dspmat_type), intent(inout), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_d_l1_jac_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
@@ -23,7 +23,7 @@
|
||||
! documentation and/or other materials provided with the distribution.
|
||||
! 3. The name of the AMG4PSBLAS group or the names of its contributors may
|
||||
! not be used to endorse or promote products derived from this
|
||||
! software without specific written permission.
|
||||
! software without specific prior written permission.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
@@ -57,7 +57,7 @@
|
||||
! documentation and/or other materials provided with the distribution.
|
||||
! 3. The name of the AMG4PSBLAS group or the names of its contributors may
|
||||
! not be used to endorse or promote products derived from this
|
||||
! software without specific written permission.
|
||||
! software without specific prior written permission.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
@@ -174,7 +174,7 @@ module amg_d_krm_solver
|
||||
& psb_dspmat_type, psb_d_base_sparse_mat, psb_d_base_vect_type,&
|
||||
& psb_ipk_, psb_i_base_vect_type
|
||||
implicit none
|
||||
type(psb_dspmat_type), intent(in), target :: a
|
||||
type(psb_dspmat_type), intent(inout), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_d_krm_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
@@ -20,7 +20,7 @@
|
||||
! documentation and/or other materials provided with the distribution.
|
||||
! 3. The name of the AMG4PSBLAS group or the names of its contributors may
|
||||
! not be used to endorse or promote products derived from this
|
||||
! software without specific written permission.
|
||||
! software without specific prior written permission.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
@@ -54,7 +54,7 @@
|
||||
! documentation and/or other materials provided with the distribution.
|
||||
! 3. The name of the AMG4PSBLAS group or the names of its contributors may
|
||||
! not be used to endorse or promote products derived from this
|
||||
! software without specific written permission.
|
||||
! software without specific prior written permission.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
|
||||
@@ -21,7 +21,7 @@
|
||||
! documentation and/or other materials provided with the distribution.
|
||||
! 3. The name of the AMG4PSBLAS group or the names of its contributors may
|
||||
! not be used to endorse or promote products derived from this
|
||||
! software without specific written permission.
|
||||
! software without specific prior written permission.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
@@ -163,7 +163,7 @@ module amg_d_mumps_solver
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
type(psb_dspmat_type), intent(in), target :: a
|
||||
type(psb_dspmat_type), intent(inout), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_d_mumps_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
@@ -20,7 +20,7 @@
|
||||
! documentation and/or other materials provided with the distribution.
|
||||
! 3. The name of the AMG4PSBLAS group or the names of its contributors may
|
||||
! not be used to endorse or promote products derived from this
|
||||
! software without specific written permission.
|
||||
! software without specific prior written permission.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
@@ -155,13 +155,35 @@ module amg_d_onelev_mod
|
||||
private :: d_wrk_alloc, d_wrk_free, &
|
||||
& d_wrk_clone, d_wrk_move_alloc, d_wrk_cnv, d_wrk_sizeof
|
||||
|
||||
!
|
||||
! Remap.
|
||||
! This keeps track of remapping.
|
||||
! Logic here is as follows:
|
||||
! 1. AC_PRE_REMAP need to figure out if we
|
||||
! really need it.
|
||||
! 2. DESC_AC_PRE_REMAP contains the descriptor before
|
||||
! remapping. Meaning that it is possible
|
||||
! to implement the RESTRICTOR operator by
|
||||
! a. Doing LINMAP_U2V onto this one
|
||||
! b. For each process, send the data to
|
||||
! IDEST.
|
||||
! This assumes that remapping goes by
|
||||
! a factor of 2.
|
||||
! For the PROLONGATOR operators, we first
|
||||
! use DESC_AC, then split and send onto
|
||||
! the processes in DESC_AC_PRE_REMAP.
|
||||
!
|
||||
! To be fixed: what happens if NP the starting processes
|
||||
! is not an even number? Coordinate with _X_remap in PSBLAS
|
||||
!
|
||||
type amg_d_remap_data_type
|
||||
type(psb_dspmat_type) :: ac_pre_remap
|
||||
type(psb_desc_type) :: desc_ac_pre_remap
|
||||
integer(psb_ipk_) :: idest
|
||||
integer(psb_ipk_), allocatable :: isrc(:), nrsrc(:), naggr(:)
|
||||
contains
|
||||
procedure, pass(rmp) :: clone => d_remap_data_clone
|
||||
procedure, pass(rmp) :: clone => d_remap_data_clone
|
||||
procedure, pass(rmp) :: move_alloc => d_remap_move_alloc
|
||||
end type amg_d_remap_data_type
|
||||
|
||||
type amg_d_onelev_type
|
||||
@@ -207,7 +229,7 @@ module amg_d_onelev_mod
|
||||
procedure, pass(lv) :: get_wrksz => d_base_onelev_get_wrksize
|
||||
procedure, pass(lv) :: allocate_wrk => d_base_onelev_allocate_wrk
|
||||
procedure, pass(lv) :: free_wrk => d_base_onelev_free_wrk
|
||||
procedure, nopass :: stringval => amg_stringval
|
||||
procedure, nopass :: stringval => amg_stringval
|
||||
procedure, pass(lv) :: move_alloc => d_base_onelev_move_alloc
|
||||
|
||||
|
||||
@@ -619,7 +641,7 @@ contains
|
||||
! Arguments
|
||||
class(amg_d_onelev_type), target, intent(inout) :: lv
|
||||
class(amg_d_onelev_type), target, intent(inout) :: lvout
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
info = psb_success_
|
||||
if (allocated(lv%sm)) then
|
||||
@@ -685,6 +707,7 @@ contains
|
||||
if (info == psb_success_) call psb_move_alloc(lv%tprol,b%tprol,info)
|
||||
if (info == psb_success_) call psb_move_alloc(lv%desc_ac,b%desc_ac,info)
|
||||
if (info == psb_success_) call psb_move_alloc(lv%linmap,b%linmap,info)
|
||||
if (info == psb_success_) call lv%remap_data%move_alloc(b%remap_data,info)
|
||||
b%base_a => lv%base_a
|
||||
b%base_desc => lv%base_desc
|
||||
|
||||
@@ -739,6 +762,7 @@ contains
|
||||
info = psb_success_
|
||||
nwv = lv%get_wrksz()
|
||||
if (.not.allocated(lv%wrk)) allocate(lv%wrk,stat=info)
|
||||
!!$ write(0,*) 'From allocate_wrk :',lv%remap_data%desc_ac_pre_remap%is_asb()
|
||||
if (info == 0) then
|
||||
if (lv%remap_data%desc_ac_pre_remap%is_asb()) then
|
||||
!
|
||||
@@ -786,47 +810,32 @@ contains
|
||||
|
||||
info = psb_success_
|
||||
call wk%free(info)
|
||||
if (present(desc2)) then
|
||||
!!$ write(0,*) 'Check on wrk_alloc 2',&
|
||||
!!$ & desc2%get_local_rows(), desc%get_local_rows(),&
|
||||
!!$ & desc2%get_local_cols(),desc%get_local_cols()
|
||||
!!$ flush(0)
|
||||
!!$ write(0,*) 'wrk_alloc D: "',trim(desc%get_fmt()),'"',&
|
||||
!!$ & present(desc2),desc%is_valid()
|
||||
|
||||
allocate(wk%wv(nwv),stat=info)
|
||||
if (present(desc2).and.(desc%is_valid())) then
|
||||
!!$ write(0,*) 'wrk_alloc D2:',desc2%get_fmt(),desc2%is_asb()
|
||||
if (desc2%get_local_cols()>desc%get_local_cols()) then
|
||||
call psb_geasb(wk%vx2l,desc2,info,&
|
||||
& scratch=.true.,mold=vmold)
|
||||
call psb_geasb(wk%vy2l,desc2,info,&
|
||||
& scratch=.true.,mold=vmold)
|
||||
call psb_geasb(wk%vtx,desc2,info,&
|
||||
& scratch=.true.,mold=vmold)
|
||||
call psb_geasb(wk%vty,desc2,info,&
|
||||
& scratch=.true.,mold=vmold)
|
||||
allocate(wk%wv(nwv),stat=info)
|
||||
do i=1,nwv
|
||||
call psb_geasb(wk%wv(i),desc2,info,&
|
||||
& scratch=.true.,mold=vmold)
|
||||
end do
|
||||
call inner_do_wrk_alloc(wk,nwv,desc2,vmold=vmold)
|
||||
else
|
||||
!!$ write(0,*) 'Check on wrk_alloc 1.5 ',&
|
||||
!!$ & desc%get_local_rows(),&
|
||||
!!$ & desc%get_local_cols()
|
||||
call psb_geasb(wk%vx2l,desc,info,&
|
||||
& scratch=.true.,mold=vmold)
|
||||
call psb_geasb(wk%vy2l,desc,info,&
|
||||
& scratch=.true.,mold=vmold)
|
||||
call psb_geasb(wk%vtx,desc,info,&
|
||||
& scratch=.true.,mold=vmold)
|
||||
call psb_geasb(wk%vty,desc,info,&
|
||||
& scratch=.true.,mold=vmold)
|
||||
allocate(wk%wv(nwv),stat=info)
|
||||
do i=1,nwv
|
||||
call psb_geasb(wk%wv(i),desc,info,&
|
||||
& scratch=.true.,mold=vmold)
|
||||
end do
|
||||
call inner_do_wrk_alloc(wk,nwv,desc,vmold=vmold)
|
||||
end if
|
||||
else
|
||||
!!$ write(0,*) 'Check on wrk_alloc 1 ',&
|
||||
!!$ & desc%get_local_rows(),&
|
||||
!!$ & desc%get_local_cols()
|
||||
else if (present(desc2)) then
|
||||
call inner_do_wrk_alloc(wk,nwv,desc2,vmold=vmold)
|
||||
else if (desc%is_valid()) then
|
||||
call inner_do_wrk_alloc(wk,nwv,desc,vmold=vmold)
|
||||
end if
|
||||
|
||||
contains
|
||||
subroutine inner_do_wrk_alloc(wk,nwv,desc,vmold)
|
||||
class(amg_dmlprec_wrk_type), target, intent(inout) :: wk
|
||||
integer(psb_ipk_), intent(in) :: nwv
|
||||
type(psb_desc_type), intent(in) :: desc
|
||||
class(psb_d_base_vect_type), intent(in), optional :: vmold
|
||||
|
||||
integer(psb_ipk_) :: i
|
||||
|
||||
call psb_geasb(wk%vx2l,desc,info,&
|
||||
& scratch=.true.,mold=vmold)
|
||||
call psb_geasb(wk%vy2l,desc,info,&
|
||||
@@ -835,12 +844,11 @@ contains
|
||||
& scratch=.true.,mold=vmold)
|
||||
call psb_geasb(wk%vty,desc,info,&
|
||||
& scratch=.true.,mold=vmold)
|
||||
allocate(wk%wv(nwv),stat=info)
|
||||
do i=1,nwv
|
||||
call psb_geasb(wk%wv(i),desc,info,&
|
||||
& scratch=.true.,mold=vmold)
|
||||
end do
|
||||
end if
|
||||
end subroutine inner_do_wrk_alloc
|
||||
end subroutine d_wrk_alloc
|
||||
|
||||
subroutine d_wrk_free(wk,info)
|
||||
@@ -993,4 +1001,25 @@ contains
|
||||
call psb_safe_ab_cpy(rmp%nrsrc,remap_out%nrsrc,info)
|
||||
end subroutine d_remap_data_clone
|
||||
|
||||
subroutine d_remap_move_alloc(rmp, remap_out, info)
|
||||
use psb_base_mod
|
||||
implicit none
|
||||
! Arguments
|
||||
class(amg_d_remap_data_type), target, intent(inout) :: rmp
|
||||
class(amg_d_remap_data_type), target, intent(inout) :: remap_out
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
!
|
||||
integer(psb_ipk_) :: i
|
||||
|
||||
info = psb_success_
|
||||
|
||||
call psb_move_alloc(rmp%ac_pre_remap,remap_out%ac_pre_remap,info)
|
||||
if (info == psb_success_) &
|
||||
& call psb_move_alloc(rmp%desc_ac_pre_remap,remap_out%desc_ac_pre_remap,info)
|
||||
remap_out%idest = rmp%idest
|
||||
call move_alloc(rmp%isrc,remap_out%isrc)
|
||||
call move_alloc(rmp%nrsrc,remap_out%nrsrc)
|
||||
call move_alloc(rmp%naggr,remap_out%naggr)
|
||||
end subroutine d_remap_move_alloc
|
||||
|
||||
end module amg_d_onelev_mod
|
||||
|
||||
@@ -20,7 +20,7 @@
|
||||
! documentation and/or other materials provided with the distribution.
|
||||
! 3. The name of the AMG4PSBLAS group or the names of its contributors may
|
||||
! not be used to endorse or promote products derived from this
|
||||
! software without specific written permission.
|
||||
! software without specific prior written permission.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
@@ -54,7 +54,7 @@
|
||||
! documentation and/or other materials provided with the distribution.
|
||||
! 3. The name of the AMG4PSBLAS group or the names of its contributors may
|
||||
! not be used to endorse or promote products derived from this
|
||||
! software without specific written permission.
|
||||
! software without specific prior written permission.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
@@ -136,7 +136,7 @@ module amg_d_parmatch_aggregator_mod
|
||||
procedure, pass(ag) :: mat_bld => amg_d_parmatch_aggregator_mat_bld
|
||||
procedure, pass(ag) :: mat_asb => amg_d_parmatch_aggregator_mat_asb
|
||||
procedure, pass(ag) :: inner_mat_asb => amg_d_parmatch_aggregator_inner_mat_asb
|
||||
procedure, pass(ag) :: bld_map => amg_d_parmatch_aggregator_bld_map
|
||||
procedure, pass(ag) :: bld_linmap => amg_d_parmatch_aggregator_bld_linmap
|
||||
procedure, pass(ag) :: csetc => amg_d_parmatch_aggr_csetc
|
||||
procedure, pass(ag) :: cseti => amg_d_parmatch_aggr_cseti
|
||||
procedure, pass(ag) :: default => amg_d_parmatch_aggr_set_default
|
||||
@@ -643,7 +643,7 @@ contains
|
||||
end select
|
||||
end subroutine amg_d_parmatch_aggregator_clone
|
||||
|
||||
subroutine amg_d_parmatch_aggregator_bld_map(ag,desc_a,desc_ac,ilaggr,nlaggr,&
|
||||
subroutine amg_d_parmatch_aggregator_bld_linmap(ag,desc_a,desc_ac,ilaggr,nlaggr,&
|
||||
& op_restr,op_prol,map,info)
|
||||
use psb_base_mod
|
||||
implicit none
|
||||
@@ -654,7 +654,7 @@ contains
|
||||
type(psb_dlinmap_type), intent(out) :: map
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20) :: name='d_parmatch_aggregator_bld_map'
|
||||
character(len=20) :: name='d_parmatch_aggregator_bld_linmap'
|
||||
|
||||
info = psb_success_
|
||||
call psb_erractionsave(err_act)
|
||||
@@ -680,5 +680,5 @@ contains
|
||||
9999 call psb_error_handler(err_act)
|
||||
|
||||
return
|
||||
end subroutine amg_d_parmatch_aggregator_bld_map
|
||||
end subroutine amg_d_parmatch_aggregator_bld_linmap
|
||||
end module amg_d_parmatch_aggregator_mod
|
||||
|
||||
@@ -20,7 +20,7 @@
|
||||
! documentation and/or other materials provided with the distribution.
|
||||
! 3. The name of the AMG4PSBLAS group or the names of its contributors may
|
||||
! not be used to endorse or promote products derived from this
|
||||
! software without specific written permission.
|
||||
! software without specific prior written permission.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
|
||||
@@ -20,7 +20,7 @@
|
||||
! documentation and/or other materials provided with the distribution.
|
||||
! 3. The name of the AMG4PSBLAS group or the names of its contributors may
|
||||
! not be used to endorse or promote products derived from this
|
||||
! software without specific written permission.
|
||||
! software without specific prior written permission.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
@@ -140,7 +140,7 @@ module amg_d_poly_smoother
|
||||
import :: psb_desc_type, amg_d_poly_smoother_type, psb_d_vect_type, psb_dpk_, &
|
||||
& psb_dspmat_type, psb_d_base_sparse_mat, psb_d_base_vect_type,&
|
||||
& psb_ipk_, psb_i_base_vect_type
|
||||
type(psb_dspmat_type), intent(in), target :: a
|
||||
type(psb_dspmat_type), intent(inout), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_d_poly_smoother_type), intent(inout) :: sm
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
@@ -20,7 +20,7 @@
|
||||
! documentation and/or other materials provided with the distribution.
|
||||
! 3. The name of the AMG4PSBLAS group or the names of its contributors may
|
||||
! not be used to endorse or promote products derived from this
|
||||
! software without specific written permission.
|
||||
! software without specific prior written permission.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
|
||||
+42
-40
@@ -20,7 +20,7 @@
|
||||
! documentation and/or other materials provided with the distribution.
|
||||
! 3. The name of the AMG4PSBLAS group or the names of its contributors may
|
||||
! not be used to endorse or promote products derived from this
|
||||
! software without specific written permission.
|
||||
! software without specific prior written permission.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
@@ -102,6 +102,7 @@ module amg_d_prec_type
|
||||
! The multilevel hierarchy
|
||||
!
|
||||
type(amg_d_onelev_type), allocatable :: precv(:)
|
||||
integer(psb_ipk_) :: nlevs
|
||||
contains
|
||||
procedure, pass(prec) :: psb_d_apply2_vect => amg_d_apply2_vect
|
||||
procedure, pass(prec) :: psb_d_apply1_vect => amg_d_apply1_vect
|
||||
@@ -119,6 +120,7 @@ module amg_d_prec_type
|
||||
procedure, pass(prec) :: cmp_complexity => amg_d_cmp_compl
|
||||
procedure, pass(prec) :: get_avg_cr => amg_d_get_avg_cr
|
||||
procedure, pass(prec) :: cmp_avg_cr => amg_d_cmp_avg_cr
|
||||
procedure, pass(prec) :: set_nlevs => amg_d_set_nlevs
|
||||
procedure, pass(prec) :: get_nlevs => amg_d_get_nlevs
|
||||
procedure, pass(prec) :: get_nzeros => amg_d_get_nzeros
|
||||
procedure, pass(prec) :: sizeof => amg_dprec_sizeof
|
||||
@@ -311,7 +313,7 @@ module amg_d_prec_type
|
||||
& psb_d_base_sparse_mat, psb_d_base_vect_type, &
|
||||
& psb_i_base_vect_type, amg_dprec_type, psb_ipk_
|
||||
implicit none
|
||||
type(psb_dspmat_type), intent(in), target :: a
|
||||
type(psb_dspmat_type), intent(inout), target :: a
|
||||
type(psb_desc_type), intent(inout), target :: desc_a
|
||||
class(amg_dprec_type), intent(inout), target :: prec
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
@@ -323,14 +325,15 @@ module amg_d_prec_type
|
||||
end interface amg_precbld
|
||||
|
||||
interface amg_hierarchy_bld
|
||||
subroutine amg_d_hierarchy_bld(a,desc_a,prec,info)
|
||||
subroutine amg_d_hierarchy_bld(a,desc_a,prec,info,cpymat)
|
||||
import :: psb_dspmat_type, psb_desc_type, psb_dpk_, &
|
||||
& amg_dprec_type, psb_ipk_
|
||||
implicit none
|
||||
type(psb_dspmat_type), intent(in), target :: a
|
||||
type(psb_dspmat_type), intent(inout), target :: a
|
||||
type(psb_desc_type), intent(inout), target :: desc_a
|
||||
class(amg_dprec_type), intent(inout), target :: prec
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
logical, intent(in), optional :: cpymat
|
||||
! character, intent(in),optional :: upd
|
||||
end subroutine amg_d_hierarchy_bld
|
||||
end interface amg_hierarchy_bld
|
||||
@@ -434,10 +437,19 @@ contains
|
||||
class(amg_dprec_type), intent(in) :: prec
|
||||
integer(psb_ipk_) :: val
|
||||
val = 0
|
||||
if (allocated(prec%precv)) then
|
||||
val = size(prec%precv)
|
||||
end if
|
||||
!!$ if (allocated(prec%precv)) then
|
||||
!!$ val = size(prec%precv)
|
||||
!!$ end if
|
||||
val = prec%nlevs
|
||||
!!$ write(0,*) ' NLEVS: ',prec%nlevs, val,size(prec%precv)
|
||||
end function amg_d_get_nlevs
|
||||
|
||||
subroutine amg_d_set_nlevs(prec,nl)
|
||||
implicit none
|
||||
class(amg_dprec_type), intent(inout) :: prec
|
||||
integer(psb_ipk_) :: nl
|
||||
prec%nlevs = nl
|
||||
end subroutine amg_d_set_nlevs
|
||||
!
|
||||
! Function returning the size of the amg_prec_type data structure
|
||||
! in bytes or in number of nonzeros of the operator(s) involved.
|
||||
@@ -508,7 +520,7 @@ contains
|
||||
|
||||
real(psb_dpk_) :: num, den, nmin
|
||||
type(psb_ctxt_type) :: ctxt
|
||||
integer(psb_ipk_) :: il
|
||||
integer(psb_ipk_) :: il,nl
|
||||
|
||||
num = -done
|
||||
den = done
|
||||
@@ -518,7 +530,10 @@ contains
|
||||
num = prec%precv(il)%base_a%get_nzeros()
|
||||
if (num >= dzero) then
|
||||
den = num
|
||||
do il=2,size(prec%precv)
|
||||
nl = prec%get_nlevs()
|
||||
!!$ write(0,*) 'Inside cmp_compl ',nl,size(prec%precv)
|
||||
do il=2, nl
|
||||
!!$ write(0,*) ' ',il,associated(prec%precv(il)%base_a)
|
||||
num = num + max(0,prec%precv(il)%base_a%get_nzeros())
|
||||
end do
|
||||
end if
|
||||
@@ -549,7 +564,6 @@ contains
|
||||
end function amg_d_get_avg_cr
|
||||
|
||||
subroutine amg_d_cmp_avg_cr(prec)
|
||||
|
||||
implicit none
|
||||
class(amg_dprec_type), intent(inout) :: prec
|
||||
|
||||
@@ -557,17 +571,18 @@ contains
|
||||
type(psb_ctxt_type) :: ctxt
|
||||
integer(psb_ipk_) :: il, nl, iam, np
|
||||
|
||||
|
||||
avgcr = dzero
|
||||
nl = prec%get_nlevs()
|
||||
do il=2,nl
|
||||
if (prec%precv(il)%base_desc%is_ok()) then
|
||||
ctxt = prec%precv(il)%base_desc%get_ctxt()
|
||||
call psb_info(ctxt,iam,np)
|
||||
if (iam >=0) avgcr = avgcr + max(dzero,prec%precv(il)%szratio)
|
||||
end if
|
||||
end do
|
||||
avgcr = avgcr / (nl-1)
|
||||
ctxt = prec%ctxt
|
||||
call psb_info(ctxt,iam,np)
|
||||
if (allocated(prec%precv)) then
|
||||
nl = size(prec%precv)
|
||||
do il=2,nl
|
||||
avgcr = avgcr + max(dzero,prec%precv(il)%szratio)
|
||||
end do
|
||||
avgcr = avgcr / (nl-1)
|
||||
end if
|
||||
call psb_sum(ctxt,avgcr)
|
||||
prec%ag_data%avg_cr = avgcr/np
|
||||
end subroutine amg_d_cmp_avg_cr
|
||||
@@ -585,9 +600,7 @@ contains
|
||||
! error code.
|
||||
!
|
||||
subroutine amg_dprecfree(p,info)
|
||||
|
||||
implicit none
|
||||
|
||||
! Arguments
|
||||
type(amg_dprec_type), intent(inout) :: p
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
@@ -613,9 +626,7 @@ contains
|
||||
end subroutine amg_dprecfree
|
||||
|
||||
subroutine amg_d_prec_free(prec,info)
|
||||
|
||||
implicit none
|
||||
|
||||
! Arguments
|
||||
class(amg_dprec_type), intent(inout) :: prec
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
@@ -647,9 +658,7 @@ contains
|
||||
end subroutine amg_d_prec_free
|
||||
|
||||
subroutine amg_d_smoothers_free(prec,info)
|
||||
|
||||
implicit none
|
||||
|
||||
! Arguments
|
||||
class(amg_dprec_type), intent(inout) :: prec
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
@@ -666,7 +675,7 @@ contains
|
||||
end if
|
||||
|
||||
if (allocated(prec%precv)) then
|
||||
do i=1,size(prec%precv)
|
||||
do i=1,prec%get_nlevs()
|
||||
call prec%precv(i)%free_smoothers(info)
|
||||
end do
|
||||
end if
|
||||
@@ -680,9 +689,7 @@ contains
|
||||
end subroutine amg_d_smoothers_free
|
||||
|
||||
subroutine amg_d_hierarchy_free(prec,info)
|
||||
|
||||
implicit none
|
||||
|
||||
! Arguments
|
||||
class(amg_dprec_type), intent(inout) :: prec
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
@@ -709,7 +716,6 @@ contains
|
||||
|
||||
end subroutine amg_d_hierarchy_free
|
||||
|
||||
|
||||
!
|
||||
! Top level methods.
|
||||
!
|
||||
@@ -774,7 +780,6 @@ contains
|
||||
|
||||
end subroutine amg_d_apply1_vect
|
||||
|
||||
|
||||
subroutine amg_d_apply2v(prec,x,y,desc_data,info,trans,work)
|
||||
implicit none
|
||||
type(psb_desc_type),intent(in) :: desc_data
|
||||
@@ -839,7 +844,6 @@ contains
|
||||
subroutine amg_d_dump(prec,info,istart,iend,iproc,prefix,head,&
|
||||
& ac,rp,smoother,solver,tprol,&
|
||||
& global_num)
|
||||
|
||||
implicit none
|
||||
class(amg_dprec_type), intent(in) :: prec
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
@@ -856,7 +860,7 @@ contains
|
||||
info = 0
|
||||
ctxt = prec%ctxt
|
||||
call psb_info(ctxt,iam,np)
|
||||
iln = size(prec%precv)
|
||||
iln = prec%get_nlevs()
|
||||
if (present(istart)) then
|
||||
il1 = max(1,istart)
|
||||
else
|
||||
@@ -880,7 +884,6 @@ contains
|
||||
end subroutine amg_d_dump
|
||||
|
||||
subroutine amg_d_cnv(prec,info,amold,vmold,imold)
|
||||
|
||||
implicit none
|
||||
class(amg_dprec_type), intent(inout) :: prec
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
@@ -892,7 +895,7 @@ contains
|
||||
|
||||
info = psb_success_
|
||||
if (allocated(prec%precv)) then
|
||||
do i=1,size(prec%precv)
|
||||
do i=1,prec%get_nlevs()
|
||||
if (info == psb_success_ ) &
|
||||
& call prec%precv(i)%cnv(info,amold=amold,vmold=vmold,imold=imold)
|
||||
end do
|
||||
@@ -901,7 +904,6 @@ contains
|
||||
end subroutine amg_d_cnv
|
||||
|
||||
subroutine amg_d_clone(prec,precout,info)
|
||||
|
||||
implicit none
|
||||
class(amg_dprec_type), intent(inout) :: prec
|
||||
class(psb_dprec_type), intent(inout) :: precout
|
||||
@@ -913,7 +915,6 @@ contains
|
||||
end subroutine amg_d_clone
|
||||
|
||||
subroutine amg_d_inner_clone(prec,precout,info)
|
||||
|
||||
implicit none
|
||||
class(amg_dprec_type), intent(inout) :: prec
|
||||
class(psb_dprec_type), target, intent(inout) :: precout
|
||||
@@ -929,8 +930,9 @@ contains
|
||||
pout%ctxt = prec%ctxt
|
||||
pout%ag_data = prec%ag_data
|
||||
pout%outer_sweeps = prec%outer_sweeps
|
||||
pout%nlevs = prec%nlevs
|
||||
if (allocated(prec%precv)) then
|
||||
ln = size(prec%precv)
|
||||
ln = prec%get_nlevs()
|
||||
allocate(pout%precv(ln),stat=info)
|
||||
if (info /= psb_success_) goto 9999
|
||||
if (ln >= 1) then
|
||||
@@ -938,6 +940,7 @@ contains
|
||||
end if
|
||||
do lev=2, ln
|
||||
if (info /= psb_success_) exit
|
||||
!!$ write(0,*) 'Inner_clone must be checked and reimplemented! '
|
||||
call prec%precv(lev)%clone(pout%precv(lev),info)
|
||||
if (info == psb_success_) then
|
||||
pout%precv(lev)%base_a => pout%precv(lev)%ac
|
||||
@@ -1002,7 +1005,7 @@ contains
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
class(psb_d_base_vect_type), intent(in), optional :: vmold
|
||||
!
|
||||
! In MLD the DESC optional argument is ignored, since
|
||||
! In AMG the DESC optional argument is ignored, since
|
||||
! the necessary info is contained in the various entries of the
|
||||
! PRECV component.
|
||||
type(psb_desc_type), intent(in), optional :: desc
|
||||
@@ -1017,7 +1020,7 @@ contains
|
||||
if (psb_errstatus_fatal()) then
|
||||
info = psb_err_internal_error_; goto 9999
|
||||
end if
|
||||
nlev = size(prec%precv)
|
||||
nlev = prec%get_nlevs()
|
||||
level = 1
|
||||
do level = 1, nlev
|
||||
call prec%precv(level)%allocate_wrk(info,vmold=vmold)
|
||||
@@ -1040,7 +1043,6 @@ contains
|
||||
subroutine amg_d_free_wrk(prec,info)
|
||||
use psb_base_mod
|
||||
implicit none
|
||||
|
||||
! Arguments
|
||||
class(amg_dprec_type), intent(inout) :: prec
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
@@ -1057,7 +1059,7 @@ contains
|
||||
end if
|
||||
|
||||
if (allocated(prec%precv)) then
|
||||
nlev = size(prec%precv)
|
||||
nlev = prec%get_nlevs()
|
||||
do level = 1, nlev
|
||||
call prec%precv(level)%free_wrk(info)
|
||||
end do
|
||||
|
||||
+262
-206
@@ -20,7 +20,7 @@
|
||||
! documentation and/or other materials provided with the distribution.
|
||||
! 3. The name of the AMG4PSBLAS group or the names of its contributors may
|
||||
! not be used to endorse or promote products derived from this
|
||||
! software without specific written permission.
|
||||
! software without specific prior written permission.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
@@ -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(inout), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_d_slu_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
type(psb_dspmat_type), intent(in), target, optional :: b
|
||||
class(psb_d_base_sparse_mat), intent(in), optional :: amold
|
||||
class(psb_d_base_vect_type), intent(in), optional :: vmold
|
||||
class(psb_i_base_vect_type), intent(in), optional :: imold
|
||||
end subroutine amg_d_slu_solver_bld
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_d_slu_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
|
||||
& trans,work,wv,info,init,initu)
|
||||
use psb_base_mod
|
||||
import amg_d_slu_solver_type
|
||||
implicit none
|
||||
type(psb_desc_type), intent(in) :: desc_data
|
||||
class(amg_d_slu_solver_type), intent(inout) :: sv
|
||||
type(psb_d_vect_type),intent(inout) :: x
|
||||
type(psb_d_vect_type),intent(inout) :: y
|
||||
real(psb_dpk_),intent(in) :: alpha,beta
|
||||
character(len=1),intent(in) :: trans
|
||||
real(psb_dpk_),target, intent(inout) :: work(:)
|
||||
type(psb_d_vect_type),intent(inout) :: wv(:)
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character, intent(in), optional :: init
|
||||
type(psb_d_vect_type),intent(inout), optional :: initu
|
||||
end subroutine amg_d_slu_solver_apply_vect
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_d_slu_solver_apply(alpha,sv,x,beta,y,desc_data,&
|
||||
& trans,work,info,init,initu)
|
||||
use psb_base_mod
|
||||
import amg_d_slu_solver_type
|
||||
implicit none
|
||||
type(psb_desc_type), intent(in) :: desc_data
|
||||
class(amg_d_slu_solver_type), intent(inout) :: sv
|
||||
real(psb_dpk_),intent(inout) :: x(:)
|
||||
real(psb_dpk_),intent(inout) :: y(:)
|
||||
real(psb_dpk_),intent(in) :: alpha,beta
|
||||
character(len=1),intent(in) :: trans
|
||||
real(psb_dpk_),target, intent(inout) :: work(:)
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character, intent(in), optional :: init
|
||||
real(psb_dpk_),intent(inout), optional :: initu(:)
|
||||
end subroutine amg_d_slu_solver_apply
|
||||
end interface
|
||||
|
||||
contains
|
||||
|
||||
subroutine d_slu_solver_apply(alpha,sv,x,beta,y,desc_data,&
|
||||
& trans,work,info,init,initu)
|
||||
use psb_base_mod
|
||||
implicit none
|
||||
type(psb_desc_type), intent(in) :: desc_data
|
||||
class(amg_d_slu_solver_type), intent(inout) :: sv
|
||||
real(psb_dpk_),intent(inout) :: x(:)
|
||||
real(psb_dpk_),intent(inout) :: y(:)
|
||||
real(psb_dpk_),intent(in) :: alpha,beta
|
||||
character(len=1),intent(in) :: trans
|
||||
real(psb_dpk_),target, intent(inout) :: work(:)
|
||||
integer, intent(out) :: info
|
||||
character, intent(in), optional :: init
|
||||
real(psb_dpk_),intent(inout), optional :: initu(:)
|
||||
|
||||
integer :: n_row,n_col
|
||||
real(psb_dpk_), pointer :: ww(:)
|
||||
type(psb_ctxt_type) :: ctxt
|
||||
integer :: np,me,i, err_act
|
||||
character :: trans_
|
||||
character(len=20) :: name='d_slu_solver_apply'
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
info = psb_success_
|
||||
|
||||
trans_ = psb_toupper(trans)
|
||||
select case(trans_)
|
||||
case('N')
|
||||
case('T','C')
|
||||
case default
|
||||
call psb_errpush(psb_err_iarg_invalid_i_,name)
|
||||
goto 9999
|
||||
end select
|
||||
!
|
||||
! For non-iterative solvers, init and initu are ignored.
|
||||
!
|
||||
|
||||
n_row = desc_data%get_local_rows()
|
||||
n_col = desc_data%get_local_cols()
|
||||
|
||||
if (n_col <= size(work)) then
|
||||
ww => work(1:n_col)
|
||||
else
|
||||
allocate(ww(n_col),stat=info)
|
||||
if (info /= psb_success_) then
|
||||
info=psb_err_alloc_request_
|
||||
call psb_errpush(info,name,i_err=(/n_col,0,0,0,0/),&
|
||||
& a_err='real(psb_dpk_)')
|
||||
goto 9999
|
||||
end if
|
||||
endif
|
||||
|
||||
ww(1:n_row) = x(1:n_row)
|
||||
select case(trans_)
|
||||
case('N')
|
||||
info = amg_dslu_solve(0,n_row,1,ww,n_row,sv%lufactors)
|
||||
case('T')
|
||||
info = amg_dslu_solve(1,n_row,1,ww,n_row,sv%lufactors)
|
||||
case('C')
|
||||
info = amg_dslu_solve(2,n_row,1,ww,n_row,sv%lufactors)
|
||||
case default
|
||||
call psb_errpush(psb_err_internal_error_, &
|
||||
& name,a_err='Invalid TRANS in ILU subsolve')
|
||||
goto 9999
|
||||
end select
|
||||
|
||||
if (info == psb_success_) &
|
||||
& call psb_geaxpby(alpha,ww,beta,y,desc_data,info)
|
||||
|
||||
|
||||
if (info /= psb_success_) then
|
||||
call psb_errpush(psb_err_internal_error_,&
|
||||
& name,a_err='Error in subsolve')
|
||||
goto 9999
|
||||
endif
|
||||
|
||||
if (n_col > size(work)) then
|
||||
deallocate(ww)
|
||||
endif
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
|
||||
end subroutine d_slu_solver_apply
|
||||
|
||||
subroutine d_slu_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
|
||||
& trans,work,wv,info,init,initu)
|
||||
use psb_base_mod
|
||||
implicit none
|
||||
type(psb_desc_type), intent(in) :: desc_data
|
||||
class(amg_d_slu_solver_type), intent(inout) :: sv
|
||||
type(psb_d_vect_type),intent(inout) :: x
|
||||
type(psb_d_vect_type),intent(inout) :: y
|
||||
real(psb_dpk_),intent(in) :: alpha,beta
|
||||
character(len=1),intent(in) :: trans
|
||||
real(psb_dpk_),target, intent(inout) :: work(:)
|
||||
type(psb_d_vect_type),intent(inout) :: wv(:)
|
||||
integer, intent(out) :: info
|
||||
character, intent(in), optional :: init
|
||||
type(psb_d_vect_type),intent(inout), optional :: initu
|
||||
|
||||
integer :: err_act
|
||||
character(len=20) :: name='d_slu_solver_apply_vect'
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
info = psb_success_
|
||||
!
|
||||
! For non-iterative solvers, init and initu are ignored.
|
||||
!
|
||||
|
||||
call x%v%sync()
|
||||
call y%v%sync()
|
||||
call sv%apply(alpha,x%v%v,beta,y%v%v,desc_data,trans,work,info)
|
||||
call y%v%set_host()
|
||||
if (info /= 0) goto 9999
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
|
||||
end subroutine d_slu_solver_apply_vect
|
||||
|
||||
subroutine d_slu_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
|
||||
|
||||
use psb_base_mod
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
type(psb_dspmat_type), intent(in), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_d_slu_solver_type), intent(inout) :: sv
|
||||
integer, intent(out) :: info
|
||||
type(psb_dspmat_type), intent(in), target, optional :: b
|
||||
class(psb_d_base_sparse_mat), intent(in), optional :: amold
|
||||
class(psb_d_base_vect_type), intent(in), optional :: vmold
|
||||
class(psb_i_base_vect_type), intent(in), optional :: imold
|
||||
! Local variables
|
||||
type(psb_dspmat_type) :: atmp
|
||||
type(psb_d_csc_sparse_mat) :: acsc
|
||||
type(psb_d_coo_sparse_mat) :: acoo
|
||||
integer :: n_row,n_col, nrow_a, nztota
|
||||
type(psb_ctxt_type) :: ctxt
|
||||
integer :: np,me,i, err_act, debug_unit, debug_level
|
||||
character(len=20) :: name='d_slu_solver_bld', ch_err
|
||||
|
||||
info=psb_success_
|
||||
call psb_erractionsave(err_act)
|
||||
debug_unit = psb_get_debug_unit()
|
||||
debug_level = psb_get_debug_level()
|
||||
ctxt = desc_a%get_context()
|
||||
call psb_info(ctxt, me, np)
|
||||
if (debug_level >= psb_debug_outer_) &
|
||||
& write(debug_unit,*) me,' ',trim(name),' start'
|
||||
|
||||
|
||||
n_row = desc_a%get_local_rows()
|
||||
n_col = desc_a%get_local_cols()
|
||||
|
||||
|
||||
call a%cscnv(atmp,info,type='coo')
|
||||
call psb_rwextd(n_row,atmp,info,b=b)
|
||||
call atmp%cscnv(info,type='coo',dupl=psb_dupl_add_)
|
||||
nrow_a = atmp%get_nrows()
|
||||
call atmp%a%csclip(acoo,info,jmax=nrow_a)
|
||||
call acsc%mv_from_coo(acoo,info)
|
||||
nztota = acsc%get_nzeros()
|
||||
! Fix the entries to call C-base SuperLU
|
||||
acsc%ia(:) = acsc%ia(:) - 1
|
||||
acsc%icp(:) = acsc%icp(:) - 1
|
||||
info = amg_dslu_fact(nrow_a,nztota,acsc%val,&
|
||||
& acsc%icp,acsc%ia,sv%lufactors)
|
||||
|
||||
if (info /= psb_success_) then
|
||||
info=psb_err_from_subroutine_
|
||||
ch_err='amg_dslu_fact'
|
||||
call psb_errpush(info,name,a_err=ch_err)
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
call acsc%free()
|
||||
call atmp%free()
|
||||
|
||||
if (debug_level >= psb_debug_outer_) &
|
||||
& write(debug_unit,*) me,' ',trim(name),' end'
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
end subroutine d_slu_solver_bld
|
||||
!!$ subroutine d_slu_solver_apply(alpha,sv,x,beta,y,desc_data,&
|
||||
!!$ & trans,work,info,init,initu)
|
||||
!!$ use psb_base_mod
|
||||
!!$ implicit none
|
||||
!!$ type(psb_desc_type), intent(in) :: desc_data
|
||||
!!$ class(amg_d_slu_solver_type), intent(inout) :: sv
|
||||
!!$ real(psb_dpk_),intent(inout) :: x(:)
|
||||
!!$ real(psb_dpk_),intent(inout) :: y(:)
|
||||
!!$ real(psb_dpk_),intent(in) :: alpha,beta
|
||||
!!$ character(len=1),intent(in) :: trans
|
||||
!!$ real(psb_dpk_),target, intent(inout) :: work(:)
|
||||
!!$ integer, intent(out) :: info
|
||||
!!$ character, intent(in), optional :: init
|
||||
!!$ real(psb_dpk_),intent(inout), optional :: initu(:)
|
||||
!!$
|
||||
!!$ integer :: n_row,n_col
|
||||
!!$ real(psb_dpk_), pointer :: ww(:)
|
||||
!!$ type(psb_ctxt_type) :: ctxt
|
||||
!!$ integer :: np,me,i, err_act
|
||||
!!$ character :: trans_
|
||||
!!$ character(len=20) :: name='d_slu_solver_apply'
|
||||
!!$
|
||||
!!$ call psb_erractionsave(err_act)
|
||||
!!$
|
||||
!!$ info = psb_success_
|
||||
!!$
|
||||
!!$ trans_ = psb_toupper(trans)
|
||||
!!$ select case(trans_)
|
||||
!!$ case('N')
|
||||
!!$ case('T','C')
|
||||
!!$ case default
|
||||
!!$ call psb_errpush(psb_err_iarg_invalid_i_,name)
|
||||
!!$ goto 9999
|
||||
!!$ end select
|
||||
!!$ !
|
||||
!!$ ! For non-iterative solvers, init and initu are ignored.
|
||||
!!$ !
|
||||
!!$
|
||||
!!$ n_row = desc_data%get_local_rows()
|
||||
!!$ n_col = desc_data%get_local_cols()
|
||||
!!$
|
||||
!!$ if (n_col <= size(work)) then
|
||||
!!$ ww => work(1:n_col)
|
||||
!!$ else
|
||||
!!$ allocate(ww(n_col),stat=info)
|
||||
!!$ if (info /= psb_success_) then
|
||||
!!$ info=psb_err_alloc_request_
|
||||
!!$ call psb_errpush(info,name,i_err=(/n_col,0,0,0,0/),&
|
||||
!!$ & a_err='real(psb_dpk_)')
|
||||
!!$ goto 9999
|
||||
!!$ end if
|
||||
!!$ endif
|
||||
!!$
|
||||
!!$ ww(1:n_row) = x(1:n_row)
|
||||
!!$ select case(trans_)
|
||||
!!$ case('N')
|
||||
!!$ info = amg_dslu_solve(0,n_row,1,ww,n_row,sv%lufactors)
|
||||
!!$ case('T')
|
||||
!!$ info = amg_dslu_solve(1,n_row,1,ww,n_row,sv%lufactors)
|
||||
!!$ case('C')
|
||||
!!$ info = amg_dslu_solve(2,n_row,1,ww,n_row,sv%lufactors)
|
||||
!!$ case default
|
||||
!!$ call psb_errpush(psb_err_internal_error_, &
|
||||
!!$ & name,a_err='Invalid TRANS in ILU subsolve')
|
||||
!!$ goto 9999
|
||||
!!$ end select
|
||||
!!$
|
||||
!!$ if (info == psb_success_) &
|
||||
!!$ & call psb_geaxpby(alpha,ww,beta,y,desc_data,info)
|
||||
!!$
|
||||
!!$
|
||||
!!$ if (info /= psb_success_) then
|
||||
!!$ call psb_errpush(psb_err_internal_error_,&
|
||||
!!$ & name,a_err='Error in subsolve')
|
||||
!!$ goto 9999
|
||||
!!$ endif
|
||||
!!$
|
||||
!!$ if (n_col > size(work)) then
|
||||
!!$ deallocate(ww)
|
||||
!!$ endif
|
||||
!!$
|
||||
!!$ call psb_erractionrestore(err_act)
|
||||
!!$ return
|
||||
!!$
|
||||
!!$9999 call psb_error_handler(err_act)
|
||||
!!$ return
|
||||
!!$
|
||||
!!$ end subroutine d_slu_solver_apply
|
||||
!!$
|
||||
!!$ subroutine d_slu_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
|
||||
!!$ & trans,work,wv,info,init,initu)
|
||||
!!$ use psb_base_mod
|
||||
!!$ implicit none
|
||||
!!$ type(psb_desc_type), intent(in) :: desc_data
|
||||
!!$ class(amg_d_slu_solver_type), intent(inout) :: sv
|
||||
!!$ type(psb_d_vect_type),intent(inout) :: x
|
||||
!!$ type(psb_d_vect_type),intent(inout) :: y
|
||||
!!$ real(psb_dpk_),intent(in) :: alpha,beta
|
||||
!!$ character(len=1),intent(in) :: trans
|
||||
!!$ real(psb_dpk_),target, intent(inout) :: work(:)
|
||||
!!$ type(psb_d_vect_type),intent(inout) :: wv(:)
|
||||
!!$ integer, intent(out) :: info
|
||||
!!$ character, intent(in), optional :: init
|
||||
!!$ type(psb_d_vect_type),intent(inout), optional :: initu
|
||||
!!$
|
||||
!!$ integer :: err_act
|
||||
!!$ character(len=20) :: name='d_slu_solver_apply_vect'
|
||||
!!$
|
||||
!!$ call psb_erractionsave(err_act)
|
||||
!!$
|
||||
!!$ info = psb_success_
|
||||
!!$ !
|
||||
!!$ ! For non-iterative solvers, init and initu are ignored.
|
||||
!!$ !
|
||||
!!$
|
||||
!!$ call x%v%sync()
|
||||
!!$ call y%v%sync()
|
||||
!!$ call sv%apply(alpha,x%v%v,beta,y%v%v,desc_data,trans,work,info)
|
||||
!!$ call y%v%set_host()
|
||||
!!$ if (info /= 0) goto 9999
|
||||
!!$
|
||||
!!$ call psb_erractionrestore(err_act)
|
||||
!!$ return
|
||||
!!$
|
||||
!!$9999 call psb_error_handler(err_act)
|
||||
!!$ return
|
||||
!!$
|
||||
!!$ end subroutine d_slu_solver_apply_vect
|
||||
!!$
|
||||
!!$ subroutine d_slu_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
|
||||
!!$
|
||||
!!$ use psb_base_mod
|
||||
!!$
|
||||
!!$ Implicit None
|
||||
!!$
|
||||
!!$ ! Arguments
|
||||
!!$ type(psb_dspmat_type), intent(in), target :: a
|
||||
!!$ Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
!!$ class(amg_d_slu_solver_type), intent(inout) :: sv
|
||||
!!$ integer, intent(out) :: info
|
||||
!!$ type(psb_dspmat_type), intent(in), target, optional :: b
|
||||
!!$ class(psb_d_base_sparse_mat), intent(in), optional :: amold
|
||||
!!$ class(psb_d_base_vect_type), intent(in), optional :: vmold
|
||||
!!$ class(psb_i_base_vect_type), intent(in), optional :: imold
|
||||
!!$ ! Local variables
|
||||
!!$ type(psb_dspmat_type) :: atmp
|
||||
!!$ type(psb_d_csc_sparse_mat) :: acsc
|
||||
!!$ type(psb_d_coo_sparse_mat) :: acoo
|
||||
!!$ integer :: n_row,n_col, nrow_a, nztota
|
||||
!!$ type(psb_ctxt_type) :: ctxt
|
||||
!!$ integer :: np,me,i, err_act, debug_unit, debug_level
|
||||
!!$ character(len=20) :: name='d_slu_solver_bld', ch_err
|
||||
!!$
|
||||
!!$ info=psb_success_
|
||||
!!$ call psb_erractionsave(err_act)
|
||||
!!$ debug_unit = psb_get_debug_unit()
|
||||
!!$ debug_level = psb_get_debug_level()
|
||||
!!$ ctxt = desc_a%get_context()
|
||||
!!$ call psb_info(ctxt, me, np)
|
||||
!!$ if (debug_level >= psb_debug_outer_) &
|
||||
!!$ & write(debug_unit,*) me,' ',trim(name),' start'
|
||||
!!$
|
||||
!!$
|
||||
!!$ n_row = desc_a%get_local_rows()
|
||||
!!$ n_col = desc_a%get_local_cols()
|
||||
!!$
|
||||
!!$
|
||||
!!$ call a%cscnv(atmp,info,type='coo')
|
||||
!!$ call psb_rwextd(n_row,atmp,info,b=b)
|
||||
!!$ call atmp%cscnv(info,type='coo',dupl=psb_dupl_add_)
|
||||
!!$ nrow_a = atmp%get_nrows()
|
||||
!!$ call atmp%a%csclip(acoo,info,jmax=nrow_a)
|
||||
!!$ call acsc%mv_from_coo(acoo,info)
|
||||
!!$ nztota = acsc%get_nzeros()
|
||||
!!$ ! Fix the entries to call C-base SuperLU
|
||||
!!$ acsc%ia(:) = acsc%ia(:) - 1
|
||||
!!$ acsc%icp(:) = acsc%icp(:) - 1
|
||||
!!$ info = amg_dslu_fact(nrow_a,nztota,acsc%val,&
|
||||
!!$ & acsc%icp,acsc%ia,sv%lufactors)
|
||||
!!$
|
||||
!!$ if (info /= psb_success_) then
|
||||
!!$ info=psb_err_from_subroutine_
|
||||
!!$ ch_err='amg_dslu_fact'
|
||||
!!$ call psb_errpush(info,name,a_err=ch_err)
|
||||
!!$ goto 9999
|
||||
!!$ end if
|
||||
!!$
|
||||
!!$ call acsc%free()
|
||||
!!$ call atmp%free()
|
||||
!!$
|
||||
!!$ if (debug_level >= psb_debug_outer_) &
|
||||
!!$ & write(debug_unit,*) me,' ',trim(name),' end'
|
||||
!!$
|
||||
!!$ call psb_erractionrestore(err_act)
|
||||
!!$ return
|
||||
!!$
|
||||
!!$9999 call psb_error_handler(err_act)
|
||||
!!$ return
|
||||
!!$ end subroutine d_slu_solver_bld
|
||||
|
||||
subroutine d_slu_solver_free(sv,info)
|
||||
|
||||
|
||||
@@ -20,7 +20,7 @@
|
||||
! documentation and/or other materials provided with the distribution.
|
||||
! 3. The name of the AMG4PSBLAS group or the names of its contributors may
|
||||
! not be used to endorse or promote products derived from this
|
||||
! software without specific written permission.
|
||||
! software without specific prior written permission.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
@@ -259,7 +259,7 @@ contains
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
type(psb_dspmat_type), intent(in), target :: a
|
||||
type(psb_dspmat_type), intent(inout), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_d_sludist_solver_type), intent(inout) :: sv
|
||||
integer, intent(out) :: info
|
||||
|
||||
@@ -20,7 +20,7 @@
|
||||
! documentation and/or other materials provided with the distribution.
|
||||
! 3. The name of the AMG4PSBLAS group or the names of its contributors may
|
||||
! not be used to endorse or promote products derived from this
|
||||
! software without specific written permission.
|
||||
! software without specific prior written permission.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
|
||||
+63
-207
@@ -20,7 +20,7 @@
|
||||
! documentation and/or other materials provided with the distribution.
|
||||
! 3. The name of the AMG4PSBLAS group or the names of its contributors may
|
||||
! not be used to endorse or promote products derived from this
|
||||
! software without specific written permission.
|
||||
! software without specific prior written permission.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
@@ -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(inout), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_d_umf_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
type(psb_dspmat_type), intent(in), target, optional :: b
|
||||
class(psb_d_base_sparse_mat), intent(in), optional :: amold
|
||||
class(psb_d_base_vect_type), intent(in), optional :: vmold
|
||||
class(psb_i_base_vect_type), intent(in), optional :: imold
|
||||
end subroutine amg_d_umf_solver_bld
|
||||
end interface
|
||||
|
||||
contains
|
||||
|
||||
subroutine d_umf_solver_apply(alpha,sv,x,beta,y,desc_data,&
|
||||
& trans,work,info,init,initu)
|
||||
use psb_base_mod
|
||||
implicit none
|
||||
type(psb_desc_type), intent(in) :: desc_data
|
||||
class(amg_d_umf_solver_type), intent(inout) :: sv
|
||||
real(psb_dpk_),intent(inout) :: x(:)
|
||||
real(psb_dpk_),intent(inout) :: y(:)
|
||||
real(psb_dpk_),intent(in) :: alpha,beta
|
||||
character(len=1),intent(in) :: trans
|
||||
real(psb_dpk_),target, intent(inout) :: work(:)
|
||||
integer, intent(out) :: info
|
||||
character, intent(in), optional :: init
|
||||
real(psb_dpk_),intent(inout), optional :: initu(:)
|
||||
|
||||
integer :: n_row,n_col
|
||||
real(psb_dpk_), pointer :: ww(:)
|
||||
integer(psb_ipk_) :: i, err_act
|
||||
character :: trans_
|
||||
character(len=20) :: name='d_umf_solver_apply'
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
info = psb_success_
|
||||
|
||||
trans_ = psb_toupper(trans)
|
||||
select case(trans_)
|
||||
case('N')
|
||||
case('T','C')
|
||||
case default
|
||||
call psb_errpush(psb_err_iarg_invalid_i_,name)
|
||||
goto 9999
|
||||
end select
|
||||
!
|
||||
! For non-iterative solvers, init and initu are ignored.
|
||||
!
|
||||
|
||||
n_row = desc_data%get_local_rows()
|
||||
n_col = desc_data%get_local_cols()
|
||||
|
||||
if (n_col <= size(work)) then
|
||||
ww => work(1:n_col)
|
||||
else
|
||||
allocate(ww(n_col),stat=info)
|
||||
if (info /= psb_success_) then
|
||||
info=psb_err_alloc_request_
|
||||
call psb_errpush(info,name,i_err=(/n_col,0,0,0,0/),&
|
||||
& a_err='real(psb_dpk_)')
|
||||
goto 9999
|
||||
end if
|
||||
endif
|
||||
|
||||
select case(trans_)
|
||||
case('N')
|
||||
info = amg_dumf_solve(0,n_row,ww,x,n_row,sv%numeric)
|
||||
case('T')
|
||||
!
|
||||
! Note: with UMF, 1 meand Ctranspose, 2 means transpose
|
||||
! even for complex data.
|
||||
!
|
||||
if (psb_d_is_complex_) then
|
||||
info = amg_dumf_solve(2,n_row,ww,x,n_row,sv%numeric)
|
||||
else
|
||||
info = amg_dumf_solve(1,n_row,ww,x,n_row,sv%numeric)
|
||||
end if
|
||||
case('C')
|
||||
info = amg_dumf_solve(1,n_row,ww,x,n_row,sv%numeric)
|
||||
case default
|
||||
call psb_errpush(psb_err_internal_error_,name,a_err='Invalid TRANS in ILU subsolve')
|
||||
goto 9999
|
||||
end select
|
||||
|
||||
if (info == psb_success_) call psb_geaxpby(alpha,ww,beta,y,desc_data,info)
|
||||
|
||||
|
||||
if (info /= psb_success_) then
|
||||
call psb_errpush(psb_err_internal_error_,name,a_err='Error in subsolve')
|
||||
goto 9999
|
||||
endif
|
||||
|
||||
if (n_col > size(work)) then
|
||||
deallocate(ww)
|
||||
endif
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
|
||||
end subroutine d_umf_solver_apply
|
||||
|
||||
subroutine d_umf_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
|
||||
& trans,work,wv,info,init,initu)
|
||||
use psb_base_mod
|
||||
implicit none
|
||||
type(psb_desc_type), intent(in) :: desc_data
|
||||
class(amg_d_umf_solver_type), intent(inout) :: sv
|
||||
type(psb_d_vect_type),intent(inout) :: x
|
||||
type(psb_d_vect_type),intent(inout) :: y
|
||||
real(psb_dpk_),intent(in) :: alpha,beta
|
||||
character(len=1),intent(in) :: trans
|
||||
real(psb_dpk_),target, intent(inout) :: work(:)
|
||||
type(psb_d_vect_type),intent(inout) :: wv(:)
|
||||
integer, intent(out) :: info
|
||||
character, intent(in), optional :: init
|
||||
type(psb_d_vect_type),intent(inout), optional :: initu
|
||||
|
||||
integer :: err_act
|
||||
character(len=20) :: name='d_umf_solver_apply_vect'
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
info = psb_success_
|
||||
!
|
||||
! For non-iterative solvers, init and initu are ignored.
|
||||
!
|
||||
|
||||
call x%v%sync()
|
||||
call y%v%sync()
|
||||
call sv%apply(alpha,x%v%v,beta,y%v%v,desc_data,trans,work,info)
|
||||
call y%v%set_host()
|
||||
if (info /= 0) goto 9999
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
|
||||
end subroutine d_umf_solver_apply_vect
|
||||
|
||||
subroutine d_umf_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
|
||||
|
||||
use psb_base_mod
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
type(psb_dspmat_type), intent(in), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_d_umf_solver_type), intent(inout) :: sv
|
||||
integer, intent(out) :: info
|
||||
type(psb_dspmat_type), intent(in), target, optional :: b
|
||||
class(psb_d_base_sparse_mat), intent(in), optional :: amold
|
||||
class(psb_d_base_vect_type), intent(in), optional :: vmold
|
||||
class(psb_i_base_vect_type), intent(in), optional :: imold
|
||||
! Local variables
|
||||
type(psb_dspmat_type) :: atmp
|
||||
type(psb_d_csc_sparse_mat) :: acsc
|
||||
integer :: n_row,n_col, nrow_a, nztota
|
||||
type(psb_ctxt_type) :: ctxt
|
||||
integer :: np,me,i, err_act, debug_unit, debug_level
|
||||
character(len=20) :: name='d_umf_solver_bld', ch_err
|
||||
|
||||
info=psb_success_
|
||||
call psb_erractionsave(err_act)
|
||||
debug_unit = psb_get_debug_unit()
|
||||
debug_level = psb_get_debug_level()
|
||||
ctxt = desc_a%get_context()
|
||||
call psb_info(ctxt, me, np)
|
||||
if (debug_level >= psb_debug_outer_) &
|
||||
& write(debug_unit,*) me,' ',trim(name),' start'
|
||||
|
||||
|
||||
n_row = desc_a%get_local_rows()
|
||||
n_col = desc_a%get_local_cols()
|
||||
|
||||
call a%cscnv(atmp,info,type='coo')
|
||||
call psb_rwextd(n_row,atmp,info,b=b)
|
||||
call atmp%cscnv(info,type='csc',dupl=psb_dupl_add_)
|
||||
call atmp%mv_to(acsc)
|
||||
nrow_a = acsc%get_nrows()
|
||||
nztota = acsc%get_nzeros()
|
||||
! Fix the entres to call C-base UMFPACK.
|
||||
acsc%ia(:) = acsc%ia(:) - 1
|
||||
acsc%icp(:) = acsc%icp(:) - 1
|
||||
info = amg_dumf_fact(nrow_a,nztota,acsc%val,&
|
||||
& acsc%ia,acsc%icp,sv%symbolic,sv%numeric,&
|
||||
& sv%symbsize,sv%numsize)
|
||||
|
||||
if (info /= psb_success_) then
|
||||
info=psb_err_from_subroutine_
|
||||
ch_err='amg_dumf_fact'
|
||||
call psb_errpush(info,name,a_err=ch_err)
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
call acsc%free()
|
||||
call atmp%free()
|
||||
|
||||
if (debug_level >= psb_debug_outer_) &
|
||||
& write(debug_unit,*) me,' ',trim(name),' end'
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
end subroutine d_umf_solver_bld
|
||||
|
||||
subroutine d_umf_solver_free(sv,info)
|
||||
|
||||
|
||||
@@ -20,7 +20,7 @@
|
||||
! documentation and/or other materials provided with the distribution.
|
||||
! 3. The name of the AMG4PSBLAS group or the names of its contributors may
|
||||
! not be used to endorse or promote products derived from this
|
||||
! software without specific written permission.
|
||||
! software without specific prior written permission.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
|
||||
@@ -20,7 +20,7 @@
|
||||
! documentation and/or other materials provided with the distribution.
|
||||
! 3. The name of the AMG4PSBLAS group or the names of its contributors may
|
||||
! not be used to endorse or promote products derived from this
|
||||
! software without specific written permission.
|
||||
! software without specific prior written permission.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
|
||||
@@ -20,7 +20,7 @@
|
||||
! documentation and/or other materials provided with the distribution.
|
||||
! 3. The name of the AMG4PSBLAS group or the names of its contributors may
|
||||
! not be used to endorse or promote products derived from this
|
||||
! software without specific written permission.
|
||||
! software without specific prior written permission.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
@@ -103,7 +103,7 @@ module amg_s_ainv_solver
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
type(psb_sspmat_type), intent(in), target :: a
|
||||
type(psb_sspmat_type), intent(inout), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_s_ainv_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
@@ -225,7 +225,7 @@ module amg_s_ainv_solver
|
||||
import :: psb_desc_type, psb_sspmat_type, psb_s_base_sparse_mat, &
|
||||
& psb_d_vect_type, psb_s_base_vect_type, psb_spk_, psb_ipk_
|
||||
implicit none
|
||||
type(psb_sspmat_type), intent(in), target :: a
|
||||
type(psb_sspmat_type), intent(inout), target :: a
|
||||
integer(psb_ipk_), intent(in) :: fillin,alg
|
||||
real(psb_spk_), intent(in) :: thresh
|
||||
type(psb_sspmat_type), intent(inout) :: wmat, zmat
|
||||
|
||||
@@ -20,7 +20,7 @@
|
||||
! documentation and/or other materials provided with the distribution.
|
||||
! 3. The name of the AMG4PSBLAS group or the names of its contributors may
|
||||
! not be used to endorse or promote products derived from this
|
||||
! software without specific written permission.
|
||||
! software without specific prior written permission.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
@@ -230,7 +230,7 @@ module amg_s_as_smoother
|
||||
& psb_desc_type, psb_s_base_sparse_mat, psb_ipk_,&
|
||||
& psb_i_base_vect_type
|
||||
implicit none
|
||||
type(psb_sspmat_type), intent(in), target :: a
|
||||
type(psb_sspmat_type), intent(inout), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_s_as_smoother_type), intent(inout) :: sm
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
@@ -20,7 +20,7 @@
|
||||
! documentation and/or other materials provided with the distribution.
|
||||
! 3. The name of the AMG4PSBLAS group or the names of its contributors may
|
||||
! not be used to endorse or promote products derived from this
|
||||
! software without specific written permission.
|
||||
! software without specific prior written permission.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
@@ -89,7 +89,7 @@ module amg_s_base_aggregator_mod
|
||||
procedure, pass(ag) :: bld_tprol => amg_s_base_aggregator_build_tprol
|
||||
procedure, pass(ag) :: mat_bld => amg_s_base_aggregator_mat_bld
|
||||
procedure, pass(ag) :: mat_asb => amg_s_base_aggregator_mat_asb
|
||||
procedure, pass(ag) :: bld_map => amg_s_base_aggregator_bld_map
|
||||
procedure, pass(ag) :: bld_linmap => amg_s_base_aggregator_bld_linmap
|
||||
procedure, pass(ag) :: update_next => amg_s_base_aggregator_update_next
|
||||
procedure, pass(ag) :: clone => amg_s_base_aggregator_clone
|
||||
procedure, pass(ag) :: free => amg_s_base_aggregator_free
|
||||
@@ -458,7 +458,7 @@ contains
|
||||
end subroutine amg_s_base_aggregator_mat_asb
|
||||
|
||||
!
|
||||
!> Function bld_map
|
||||
!> Function bld_linmap
|
||||
!! \memberof amg_s_base_aggregator_type
|
||||
!! \brief Build linear map between hierarchy levels
|
||||
!!
|
||||
@@ -473,7 +473,7 @@ contains
|
||||
!! \param map The output map
|
||||
!! \param info Return code
|
||||
!!
|
||||
subroutine amg_s_base_aggregator_bld_map(ag,desc_a,desc_ac,ilaggr,nlaggr,&
|
||||
subroutine amg_s_base_aggregator_bld_linmap(ag,desc_a,desc_ac,ilaggr,nlaggr,&
|
||||
& op_restr,op_prol,map,info)
|
||||
use psb_base_mod
|
||||
implicit none
|
||||
@@ -484,7 +484,7 @@ contains
|
||||
type(psb_slinmap_type), intent(out) :: map
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20) :: name='s_base_aggregator_bld_map'
|
||||
character(len=20) :: name='s_base_aggregator_bld_linmap'
|
||||
|
||||
info = psb_success_
|
||||
call psb_erractionsave(err_act)
|
||||
@@ -508,7 +508,6 @@ contains
|
||||
9999 call psb_error_handler(err_act)
|
||||
|
||||
return
|
||||
end subroutine amg_s_base_aggregator_bld_map
|
||||
|
||||
end subroutine amg_s_base_aggregator_bld_linmap
|
||||
|
||||
end module amg_s_base_aggregator_mod
|
||||
|
||||
@@ -20,7 +20,7 @@
|
||||
! documentation and/or other materials provided with the distribution.
|
||||
! 3. The name of the AMG4PSBLAS group or the names of its contributors may
|
||||
! not be used to endorse or promote products derived from this
|
||||
! software without specific written permission.
|
||||
! software without specific prior written permission.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
|
||||
@@ -20,7 +20,7 @@
|
||||
! documentation and/or other materials provided with the distribution.
|
||||
! 3. The name of the AMG4PSBLAS group or the names of its contributors may
|
||||
! not be used to endorse or promote products derived from this
|
||||
! software without specific written permission.
|
||||
! software without specific prior written permission.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
@@ -237,7 +237,7 @@ module amg_s_base_smoother_mod
|
||||
& psb_s_vect_type, psb_s_base_vect_type, psb_spk_, &
|
||||
& amg_s_base_smoother_type, psb_ipk_, psb_i_base_vect_type
|
||||
! Arguments
|
||||
type(psb_sspmat_type), intent(in), target :: a
|
||||
type(psb_sspmat_type), intent(inout), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_s_base_smoother_type), intent(inout) :: sm
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
@@ -20,7 +20,7 @@
|
||||
! documentation and/or other materials provided with the distribution.
|
||||
! 3. The name of the AMG4PSBLAS group or the names of its contributors may
|
||||
! not be used to endorse or promote products derived from this
|
||||
! software without specific written permission.
|
||||
! software without specific prior written permission.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
@@ -170,7 +170,7 @@ module amg_s_base_solver_mod
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
type(psb_sspmat_type), intent(in), target :: a
|
||||
type(psb_sspmat_type), intent(inout), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_s_base_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
@@ -20,7 +20,7 @@
|
||||
! documentation and/or other materials provided with the distribution.
|
||||
! 3. The name of the AMG4PSBLAS group or the names of its contributors may
|
||||
! not be used to endorse or promote products derived from this
|
||||
! software without specific written permission.
|
||||
! software without specific prior written permission.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
|
||||
@@ -20,7 +20,7 @@
|
||||
! documentation and/or other materials provided with the distribution.
|
||||
! 3. The name of the AMG4PSBLAS group or the names of its contributors may
|
||||
! not be used to endorse or promote products derived from this
|
||||
! software without specific written permission.
|
||||
! software without specific prior written permission.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
@@ -119,7 +119,7 @@ module amg_s_diag_solver
|
||||
import :: psb_desc_type, psb_sspmat_type, psb_s_base_sparse_mat, &
|
||||
& psb_s_vect_type, psb_s_base_vect_type, psb_spk_, &
|
||||
& amg_s_diag_solver_type, psb_ipk_, psb_i_base_vect_type
|
||||
type(psb_sspmat_type), intent(in), target :: a
|
||||
type(psb_sspmat_type), intent(inout), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_s_diag_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
@@ -331,7 +331,7 @@ module amg_s_l1_diag_solver
|
||||
import :: psb_desc_type, psb_sspmat_type, psb_s_base_sparse_mat, &
|
||||
& psb_s_vect_type, psb_s_base_vect_type, psb_spk_, &
|
||||
& amg_s_l1_diag_solver_type, psb_ipk_, psb_i_base_vect_type
|
||||
type(psb_sspmat_type), intent(in), target :: a
|
||||
type(psb_sspmat_type), intent(inout), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_s_l1_diag_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
@@ -20,7 +20,7 @@
|
||||
! documentation and/or other materials provided with the distribution.
|
||||
! 3. The name of the AMG4PSBLAS group or the names of its contributors may
|
||||
! not be used to endorse or promote products derived from this
|
||||
! software without specific written permission.
|
||||
! software without specific prior written permission.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
@@ -181,7 +181,7 @@ module amg_s_gs_solver
|
||||
& psb_sspmat_type, psb_s_base_sparse_mat, psb_s_base_vect_type,&
|
||||
& psb_ipk_, psb_i_base_vect_type
|
||||
implicit none
|
||||
type(psb_sspmat_type), intent(in), target :: a
|
||||
type(psb_sspmat_type), intent(inout), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_s_gs_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
@@ -195,7 +195,7 @@ module amg_s_gs_solver
|
||||
& psb_sspmat_type, psb_s_base_sparse_mat, psb_s_base_vect_type,&
|
||||
& psb_ipk_, psb_i_base_vect_type
|
||||
implicit none
|
||||
type(psb_sspmat_type), intent(in), target :: a
|
||||
type(psb_sspmat_type), intent(inout), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_s_bwgs_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
@@ -20,7 +20,7 @@
|
||||
! documentation and/or other materials provided with the distribution.
|
||||
! 3. The name of the AMG4PSBLAS group or the names of its contributors may
|
||||
! not be used to endorse or promote products derived from this
|
||||
! software without specific written permission.
|
||||
! software without specific prior written permission.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
@@ -123,7 +123,7 @@ contains
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
type(psb_sspmat_type), intent(in), target :: a
|
||||
type(psb_sspmat_type), intent(inout), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_s_id_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
@@ -20,7 +20,7 @@
|
||||
! documentation and/or other materials provided with the distribution.
|
||||
! 3. The name of the AMG4PSBLAS group or the names of its contributors may
|
||||
! not be used to endorse or promote products derived from this
|
||||
! software without specific written permission.
|
||||
! software without specific prior written permission.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
|
||||
@@ -20,7 +20,7 @@
|
||||
! documentation and/or other materials provided with the distribution.
|
||||
! 3. The name of the AMG4PSBLAS group or the names of its contributors may
|
||||
! not be used to endorse or promote products derived from this
|
||||
! software without specific written permission.
|
||||
! software without specific prior written permission.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
@@ -144,7 +144,7 @@ module amg_s_ilu_solver
|
||||
& psb_sspmat_type, psb_s_base_sparse_mat, psb_s_base_vect_type,&
|
||||
& psb_ipk_, psb_i_base_vect_type
|
||||
implicit none
|
||||
type(psb_sspmat_type), intent(in), target :: a
|
||||
type(psb_sspmat_type), intent(inout), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_s_ilu_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
@@ -20,7 +20,7 @@
|
||||
! documentation and/or other materials provided with the distribution.
|
||||
! 3. The name of the AMG4PSBLAS group or the names of its contributors may
|
||||
! not be used to endorse or promote products derived from this
|
||||
! software without specific written permission.
|
||||
! software without specific prior written permission.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
@@ -56,7 +56,7 @@ module amg_s_inner_mod
|
||||
& psb_spk_, psb_s_base_sparse_mat, psb_s_base_vect_type, psb_ipk_
|
||||
import :: amg_sprec_type
|
||||
implicit none
|
||||
type(psb_sspmat_type), intent(in), target :: a
|
||||
type(psb_sspmat_type), intent(inout), target :: a
|
||||
type(psb_desc_type), intent(inout), target :: desc_a
|
||||
type(amg_sprec_type), intent(inout), target :: prec
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
@@ -67,7 +67,7 @@ module amg_s_inner_mod
|
||||
end interface amg_mlprec_bld
|
||||
|
||||
interface amg_mlprec_aply
|
||||
subroutine amg_smlprec_aply(alpha,p,x,beta,y,desc_data,trans,work,info)
|
||||
subroutine amg_smlprec_aply_a(alpha,p,x,beta,y,desc_data,trans,work,info)
|
||||
import :: psb_sspmat_type, psb_desc_type, psb_spk_, psb_ipk_
|
||||
import :: amg_sprec_type
|
||||
implicit none
|
||||
@@ -79,7 +79,7 @@ module amg_s_inner_mod
|
||||
character,intent(in) :: trans
|
||||
real(psb_spk_),target :: work(:)
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine amg_smlprec_aply
|
||||
end subroutine amg_smlprec_aply_a
|
||||
subroutine amg_smlprec_aply_vect(alpha,p,x,beta,y,desc_data,trans,work,info)
|
||||
import :: psb_sspmat_type, psb_desc_type, &
|
||||
& psb_spk_, psb_s_vect_type, psb_ipk_
|
||||
|
||||
@@ -20,7 +20,7 @@
|
||||
! documentation and/or other materials provided with the distribution.
|
||||
! 3. The name of the AMG4PSBLAS group or the names of its contributors may
|
||||
! not be used to endorse or promote products derived from this
|
||||
! software without specific written permission.
|
||||
! software without specific prior written permission.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
@@ -94,7 +94,7 @@ module amg_s_invk_solver
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
type(psb_sspmat_type), intent(in), target :: a
|
||||
type(psb_sspmat_type), intent(inout), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_s_invk_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
@@ -20,7 +20,7 @@
|
||||
! documentation and/or other materials provided with the distribution.
|
||||
! 3. The name of the AMG4PSBLAS group or the names of its contributors may
|
||||
! not be used to endorse or promote products derived from this
|
||||
! software without specific written permission.
|
||||
! software without specific prior written permission.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
@@ -94,7 +94,7 @@ module amg_s_invt_solver
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
type(psb_sspmat_type), intent(in), target :: a
|
||||
type(psb_sspmat_type), intent(inout), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_s_invt_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
@@ -20,7 +20,7 @@
|
||||
! documentation and/or other materials provided with the distribution.
|
||||
! 3. The name of the AMG4PSBLAS group or the names of its contributors may
|
||||
! not be used to endorse or promote products derived from this
|
||||
! software without specific written permission.
|
||||
! software without specific prior written permission.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
@@ -151,7 +151,7 @@ module amg_s_jac_smoother
|
||||
import :: psb_desc_type, amg_s_jac_smoother_type, psb_s_vect_type, psb_spk_, &
|
||||
& psb_sspmat_type, psb_s_base_sparse_mat, psb_s_base_vect_type,&
|
||||
& psb_ipk_, psb_i_base_vect_type
|
||||
type(psb_sspmat_type), intent(in), target :: a
|
||||
type(psb_sspmat_type), intent(inout), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_s_jac_smoother_type), intent(inout) :: sm
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
@@ -274,7 +274,7 @@ module amg_s_jac_smoother
|
||||
import :: psb_desc_type, amg_s_l1_jac_smoother_type, psb_s_vect_type, &
|
||||
& psb_sspmat_type, psb_s_base_sparse_mat, psb_s_base_vect_type,&
|
||||
& psb_ipk_, psb_i_base_vect_type
|
||||
type(psb_sspmat_type), intent(in), target :: a
|
||||
type(psb_sspmat_type), intent(inout), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_s_l1_jac_smoother_type), intent(inout) :: sm
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
@@ -20,7 +20,7 @@
|
||||
! documentation and/or other materials provided with the distribution.
|
||||
! 3. The name of the AMG4PSBLAS group or the names of its contributors may
|
||||
! not be used to endorse or promote products derived from this
|
||||
! software without specific written permission.
|
||||
! software without specific prior written permission.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
@@ -143,7 +143,7 @@ module amg_s_jac_solver
|
||||
& psb_sspmat_type, psb_s_base_sparse_mat, psb_s_base_vect_type,&
|
||||
& psb_ipk_, psb_i_base_vect_type
|
||||
implicit none
|
||||
type(psb_sspmat_type), intent(in), target :: a
|
||||
type(psb_sspmat_type), intent(inout), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_s_jac_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
@@ -160,7 +160,7 @@ module amg_s_jac_solver
|
||||
& psb_sspmat_type, psb_s_base_sparse_mat, psb_s_base_vect_type,&
|
||||
& psb_ipk_, psb_i_base_vect_type
|
||||
implicit none
|
||||
type(psb_sspmat_type), intent(in), target :: a
|
||||
type(psb_sspmat_type), intent(inout), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_s_l1_jac_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
@@ -23,7 +23,7 @@
|
||||
! documentation and/or other materials provided with the distribution.
|
||||
! 3. The name of the AMG4PSBLAS group or the names of its contributors may
|
||||
! not be used to endorse or promote products derived from this
|
||||
! software without specific written permission.
|
||||
! software without specific prior written permission.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
@@ -57,7 +57,7 @@
|
||||
! documentation and/or other materials provided with the distribution.
|
||||
! 3. The name of the AMG4PSBLAS group or the names of its contributors may
|
||||
! not be used to endorse or promote products derived from this
|
||||
! software without specific written permission.
|
||||
! software without specific prior written permission.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
@@ -174,7 +174,7 @@ module amg_s_krm_solver
|
||||
& psb_sspmat_type, psb_s_base_sparse_mat, psb_s_base_vect_type,&
|
||||
& psb_ipk_, psb_i_base_vect_type
|
||||
implicit none
|
||||
type(psb_sspmat_type), intent(in), target :: a
|
||||
type(psb_sspmat_type), intent(inout), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_s_krm_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
@@ -20,7 +20,7 @@
|
||||
! documentation and/or other materials provided with the distribution.
|
||||
! 3. The name of the AMG4PSBLAS group or the names of its contributors may
|
||||
! not be used to endorse or promote products derived from this
|
||||
! software without specific written permission.
|
||||
! software without specific prior written permission.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
@@ -54,7 +54,7 @@
|
||||
! documentation and/or other materials provided with the distribution.
|
||||
! 3. The name of the AMG4PSBLAS group or the names of its contributors may
|
||||
! not be used to endorse or promote products derived from this
|
||||
! software without specific written permission.
|
||||
! software without specific prior written permission.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
|
||||
@@ -21,7 +21,7 @@
|
||||
! documentation and/or other materials provided with the distribution.
|
||||
! 3. The name of the AMG4PSBLAS group or the names of its contributors may
|
||||
! not be used to endorse or promote products derived from this
|
||||
! software without specific written permission.
|
||||
! software without specific prior written permission.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
@@ -163,7 +163,7 @@ module amg_s_mumps_solver
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
type(psb_sspmat_type), intent(in), target :: a
|
||||
type(psb_sspmat_type), intent(inout), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_s_mumps_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
@@ -20,7 +20,7 @@
|
||||
! documentation and/or other materials provided with the distribution.
|
||||
! 3. The name of the AMG4PSBLAS group or the names of its contributors may
|
||||
! not be used to endorse or promote products derived from this
|
||||
! software without specific written permission.
|
||||
! software without specific prior written permission.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
@@ -155,13 +155,35 @@ module amg_s_onelev_mod
|
||||
private :: s_wrk_alloc, s_wrk_free, &
|
||||
& s_wrk_clone, s_wrk_move_alloc, s_wrk_cnv, s_wrk_sizeof
|
||||
|
||||
!
|
||||
! Remap.
|
||||
! This keeps track of remapping.
|
||||
! Logic here is as follows:
|
||||
! 1. AC_PRE_REMAP need to figure out if we
|
||||
! really need it.
|
||||
! 2. DESC_AC_PRE_REMAP contains the descriptor before
|
||||
! remapping. Meaning that it is possible
|
||||
! to implement the RESTRICTOR operator by
|
||||
! a. Doing LINMAP_U2V onto this one
|
||||
! b. For each process, send the data to
|
||||
! IDEST.
|
||||
! This assumes that remapping goes by
|
||||
! a factor of 2.
|
||||
! For the PROLONGATOR operators, we first
|
||||
! use DESC_AC, then split and send onto
|
||||
! the processes in DESC_AC_PRE_REMAP.
|
||||
!
|
||||
! To be fixed: what happens if NP the starting processes
|
||||
! is not an even number? Coordinate with _X_remap in PSBLAS
|
||||
!
|
||||
type amg_s_remap_data_type
|
||||
type(psb_sspmat_type) :: ac_pre_remap
|
||||
type(psb_desc_type) :: desc_ac_pre_remap
|
||||
integer(psb_ipk_) :: idest
|
||||
integer(psb_ipk_), allocatable :: isrc(:), nrsrc(:), naggr(:)
|
||||
contains
|
||||
procedure, pass(rmp) :: clone => s_remap_data_clone
|
||||
procedure, pass(rmp) :: clone => s_remap_data_clone
|
||||
procedure, pass(rmp) :: move_alloc => s_remap_move_alloc
|
||||
end type amg_s_remap_data_type
|
||||
|
||||
type amg_s_onelev_type
|
||||
@@ -207,7 +229,7 @@ module amg_s_onelev_mod
|
||||
procedure, pass(lv) :: get_wrksz => s_base_onelev_get_wrksize
|
||||
procedure, pass(lv) :: allocate_wrk => s_base_onelev_allocate_wrk
|
||||
procedure, pass(lv) :: free_wrk => s_base_onelev_free_wrk
|
||||
procedure, nopass :: stringval => amg_stringval
|
||||
procedure, nopass :: stringval => amg_stringval
|
||||
procedure, pass(lv) :: move_alloc => s_base_onelev_move_alloc
|
||||
|
||||
|
||||
@@ -619,7 +641,7 @@ contains
|
||||
! Arguments
|
||||
class(amg_s_onelev_type), target, intent(inout) :: lv
|
||||
class(amg_s_onelev_type), target, intent(inout) :: lvout
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
info = psb_success_
|
||||
if (allocated(lv%sm)) then
|
||||
@@ -685,6 +707,7 @@ contains
|
||||
if (info == psb_success_) call psb_move_alloc(lv%tprol,b%tprol,info)
|
||||
if (info == psb_success_) call psb_move_alloc(lv%desc_ac,b%desc_ac,info)
|
||||
if (info == psb_success_) call psb_move_alloc(lv%linmap,b%linmap,info)
|
||||
if (info == psb_success_) call lv%remap_data%move_alloc(b%remap_data,info)
|
||||
b%base_a => lv%base_a
|
||||
b%base_desc => lv%base_desc
|
||||
|
||||
@@ -739,6 +762,7 @@ contains
|
||||
info = psb_success_
|
||||
nwv = lv%get_wrksz()
|
||||
if (.not.allocated(lv%wrk)) allocate(lv%wrk,stat=info)
|
||||
!!$ write(0,*) 'From allocate_wrk :',lv%remap_data%desc_ac_pre_remap%is_asb()
|
||||
if (info == 0) then
|
||||
if (lv%remap_data%desc_ac_pre_remap%is_asb()) then
|
||||
!
|
||||
@@ -786,47 +810,32 @@ contains
|
||||
|
||||
info = psb_success_
|
||||
call wk%free(info)
|
||||
if (present(desc2)) then
|
||||
!!$ write(0,*) 'Check on wrk_alloc 2',&
|
||||
!!$ & desc2%get_local_rows(), desc%get_local_rows(),&
|
||||
!!$ & desc2%get_local_cols(),desc%get_local_cols()
|
||||
!!$ flush(0)
|
||||
!!$ write(0,*) 'wrk_alloc D: "',trim(desc%get_fmt()),'"',&
|
||||
!!$ & present(desc2),desc%is_valid()
|
||||
|
||||
allocate(wk%wv(nwv),stat=info)
|
||||
if (present(desc2).and.(desc%is_valid())) then
|
||||
!!$ write(0,*) 'wrk_alloc D2:',desc2%get_fmt(),desc2%is_asb()
|
||||
if (desc2%get_local_cols()>desc%get_local_cols()) then
|
||||
call psb_geasb(wk%vx2l,desc2,info,&
|
||||
& scratch=.true.,mold=vmold)
|
||||
call psb_geasb(wk%vy2l,desc2,info,&
|
||||
& scratch=.true.,mold=vmold)
|
||||
call psb_geasb(wk%vtx,desc2,info,&
|
||||
& scratch=.true.,mold=vmold)
|
||||
call psb_geasb(wk%vty,desc2,info,&
|
||||
& scratch=.true.,mold=vmold)
|
||||
allocate(wk%wv(nwv),stat=info)
|
||||
do i=1,nwv
|
||||
call psb_geasb(wk%wv(i),desc2,info,&
|
||||
& scratch=.true.,mold=vmold)
|
||||
end do
|
||||
call inner_do_wrk_alloc(wk,nwv,desc2,vmold=vmold)
|
||||
else
|
||||
!!$ write(0,*) 'Check on wrk_alloc 1.5 ',&
|
||||
!!$ & desc%get_local_rows(),&
|
||||
!!$ & desc%get_local_cols()
|
||||
call psb_geasb(wk%vx2l,desc,info,&
|
||||
& scratch=.true.,mold=vmold)
|
||||
call psb_geasb(wk%vy2l,desc,info,&
|
||||
& scratch=.true.,mold=vmold)
|
||||
call psb_geasb(wk%vtx,desc,info,&
|
||||
& scratch=.true.,mold=vmold)
|
||||
call psb_geasb(wk%vty,desc,info,&
|
||||
& scratch=.true.,mold=vmold)
|
||||
allocate(wk%wv(nwv),stat=info)
|
||||
do i=1,nwv
|
||||
call psb_geasb(wk%wv(i),desc,info,&
|
||||
& scratch=.true.,mold=vmold)
|
||||
end do
|
||||
call inner_do_wrk_alloc(wk,nwv,desc,vmold=vmold)
|
||||
end if
|
||||
else
|
||||
!!$ write(0,*) 'Check on wrk_alloc 1 ',&
|
||||
!!$ & desc%get_local_rows(),&
|
||||
!!$ & desc%get_local_cols()
|
||||
else if (present(desc2)) then
|
||||
call inner_do_wrk_alloc(wk,nwv,desc2,vmold=vmold)
|
||||
else if (desc%is_valid()) then
|
||||
call inner_do_wrk_alloc(wk,nwv,desc,vmold=vmold)
|
||||
end if
|
||||
|
||||
contains
|
||||
subroutine inner_do_wrk_alloc(wk,nwv,desc,vmold)
|
||||
class(amg_smlprec_wrk_type), target, intent(inout) :: wk
|
||||
integer(psb_ipk_), intent(in) :: nwv
|
||||
type(psb_desc_type), intent(in) :: desc
|
||||
class(psb_s_base_vect_type), intent(in), optional :: vmold
|
||||
|
||||
integer(psb_ipk_) :: i
|
||||
|
||||
call psb_geasb(wk%vx2l,desc,info,&
|
||||
& scratch=.true.,mold=vmold)
|
||||
call psb_geasb(wk%vy2l,desc,info,&
|
||||
@@ -835,12 +844,11 @@ contains
|
||||
& scratch=.true.,mold=vmold)
|
||||
call psb_geasb(wk%vty,desc,info,&
|
||||
& scratch=.true.,mold=vmold)
|
||||
allocate(wk%wv(nwv),stat=info)
|
||||
do i=1,nwv
|
||||
call psb_geasb(wk%wv(i),desc,info,&
|
||||
& scratch=.true.,mold=vmold)
|
||||
end do
|
||||
end if
|
||||
end subroutine inner_do_wrk_alloc
|
||||
end subroutine s_wrk_alloc
|
||||
|
||||
subroutine s_wrk_free(wk,info)
|
||||
@@ -993,4 +1001,25 @@ contains
|
||||
call psb_safe_ab_cpy(rmp%nrsrc,remap_out%nrsrc,info)
|
||||
end subroutine s_remap_data_clone
|
||||
|
||||
subroutine s_remap_move_alloc(rmp, remap_out, info)
|
||||
use psb_base_mod
|
||||
implicit none
|
||||
! Arguments
|
||||
class(amg_s_remap_data_type), target, intent(inout) :: rmp
|
||||
class(amg_s_remap_data_type), target, intent(inout) :: remap_out
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
!
|
||||
integer(psb_ipk_) :: i
|
||||
|
||||
info = psb_success_
|
||||
|
||||
call psb_move_alloc(rmp%ac_pre_remap,remap_out%ac_pre_remap,info)
|
||||
if (info == psb_success_) &
|
||||
& call psb_move_alloc(rmp%desc_ac_pre_remap,remap_out%desc_ac_pre_remap,info)
|
||||
remap_out%idest = rmp%idest
|
||||
call move_alloc(rmp%isrc,remap_out%isrc)
|
||||
call move_alloc(rmp%nrsrc,remap_out%nrsrc)
|
||||
call move_alloc(rmp%naggr,remap_out%naggr)
|
||||
end subroutine s_remap_move_alloc
|
||||
|
||||
end module amg_s_onelev_mod
|
||||
|
||||
@@ -20,7 +20,7 @@
|
||||
! documentation and/or other materials provided with the distribution.
|
||||
! 3. The name of the AMG4PSBLAS group or the names of its contributors may
|
||||
! not be used to endorse or promote products derived from this
|
||||
! software without specific written permission.
|
||||
! software without specific prior written permission.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
@@ -54,7 +54,7 @@
|
||||
! documentation and/or other materials provided with the distribution.
|
||||
! 3. The name of the AMG4PSBLAS group or the names of its contributors may
|
||||
! not be used to endorse or promote products derived from this
|
||||
! software without specific written permission.
|
||||
! software without specific prior written permission.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
@@ -136,7 +136,7 @@ module amg_s_parmatch_aggregator_mod
|
||||
procedure, pass(ag) :: mat_bld => amg_s_parmatch_aggregator_mat_bld
|
||||
procedure, pass(ag) :: mat_asb => amg_s_parmatch_aggregator_mat_asb
|
||||
procedure, pass(ag) :: inner_mat_asb => amg_s_parmatch_aggregator_inner_mat_asb
|
||||
procedure, pass(ag) :: bld_map => amg_s_parmatch_aggregator_bld_map
|
||||
procedure, pass(ag) :: bld_linmap => amg_s_parmatch_aggregator_bld_linmap
|
||||
procedure, pass(ag) :: csetc => amg_s_parmatch_aggr_csetc
|
||||
procedure, pass(ag) :: cseti => amg_s_parmatch_aggr_cseti
|
||||
procedure, pass(ag) :: default => amg_s_parmatch_aggr_set_default
|
||||
@@ -643,7 +643,7 @@ contains
|
||||
end select
|
||||
end subroutine amg_s_parmatch_aggregator_clone
|
||||
|
||||
subroutine amg_s_parmatch_aggregator_bld_map(ag,desc_a,desc_ac,ilaggr,nlaggr,&
|
||||
subroutine amg_s_parmatch_aggregator_bld_linmap(ag,desc_a,desc_ac,ilaggr,nlaggr,&
|
||||
& op_restr,op_prol,map,info)
|
||||
use psb_base_mod
|
||||
implicit none
|
||||
@@ -654,7 +654,7 @@ contains
|
||||
type(psb_slinmap_type), intent(out) :: map
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20) :: name='s_parmatch_aggregator_bld_map'
|
||||
character(len=20) :: name='s_parmatch_aggregator_bld_linmap'
|
||||
|
||||
info = psb_success_
|
||||
call psb_erractionsave(err_act)
|
||||
@@ -680,5 +680,5 @@ contains
|
||||
9999 call psb_error_handler(err_act)
|
||||
|
||||
return
|
||||
end subroutine amg_s_parmatch_aggregator_bld_map
|
||||
end subroutine amg_s_parmatch_aggregator_bld_linmap
|
||||
end module amg_s_parmatch_aggregator_mod
|
||||
|
||||
@@ -20,7 +20,7 @@
|
||||
! documentation and/or other materials provided with the distribution.
|
||||
! 3. The name of the AMG4PSBLAS group or the names of its contributors may
|
||||
! not be used to endorse or promote products derived from this
|
||||
! software without specific written permission.
|
||||
! software without specific prior written permission.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
@@ -140,7 +140,7 @@ module amg_s_poly_smoother
|
||||
import :: psb_desc_type, amg_s_poly_smoother_type, psb_s_vect_type, psb_spk_, &
|
||||
& psb_sspmat_type, psb_s_base_sparse_mat, psb_s_base_vect_type,&
|
||||
& psb_ipk_, psb_i_base_vect_type
|
||||
type(psb_sspmat_type), intent(in), target :: a
|
||||
type(psb_sspmat_type), intent(inout), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_s_poly_smoother_type), intent(inout) :: sm
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
@@ -20,7 +20,7 @@
|
||||
! documentation and/or other materials provided with the distribution.
|
||||
! 3. The name of the AMG4PSBLAS group or the names of its contributors may
|
||||
! not be used to endorse or promote products derived from this
|
||||
! software without specific written permission.
|
||||
! software without specific prior written permission.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
|
||||
+42
-40
@@ -20,7 +20,7 @@
|
||||
! documentation and/or other materials provided with the distribution.
|
||||
! 3. The name of the AMG4PSBLAS group or the names of its contributors may
|
||||
! not be used to endorse or promote products derived from this
|
||||
! software without specific written permission.
|
||||
! software without specific prior written permission.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
@@ -102,6 +102,7 @@ module amg_s_prec_type
|
||||
! The multilevel hierarchy
|
||||
!
|
||||
type(amg_s_onelev_type), allocatable :: precv(:)
|
||||
integer(psb_ipk_) :: nlevs
|
||||
contains
|
||||
procedure, pass(prec) :: psb_s_apply2_vect => amg_s_apply2_vect
|
||||
procedure, pass(prec) :: psb_s_apply1_vect => amg_s_apply1_vect
|
||||
@@ -119,6 +120,7 @@ module amg_s_prec_type
|
||||
procedure, pass(prec) :: cmp_complexity => amg_s_cmp_compl
|
||||
procedure, pass(prec) :: get_avg_cr => amg_s_get_avg_cr
|
||||
procedure, pass(prec) :: cmp_avg_cr => amg_s_cmp_avg_cr
|
||||
procedure, pass(prec) :: set_nlevs => amg_s_set_nlevs
|
||||
procedure, pass(prec) :: get_nlevs => amg_s_get_nlevs
|
||||
procedure, pass(prec) :: get_nzeros => amg_s_get_nzeros
|
||||
procedure, pass(prec) :: sizeof => amg_sprec_sizeof
|
||||
@@ -311,7 +313,7 @@ module amg_s_prec_type
|
||||
& psb_s_base_sparse_mat, psb_s_base_vect_type, &
|
||||
& psb_i_base_vect_type, amg_sprec_type, psb_ipk_
|
||||
implicit none
|
||||
type(psb_sspmat_type), intent(in), target :: a
|
||||
type(psb_sspmat_type), intent(inout), target :: a
|
||||
type(psb_desc_type), intent(inout), target :: desc_a
|
||||
class(amg_sprec_type), intent(inout), target :: prec
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
@@ -323,14 +325,15 @@ module amg_s_prec_type
|
||||
end interface amg_precbld
|
||||
|
||||
interface amg_hierarchy_bld
|
||||
subroutine amg_s_hierarchy_bld(a,desc_a,prec,info)
|
||||
subroutine amg_s_hierarchy_bld(a,desc_a,prec,info,cpymat)
|
||||
import :: psb_sspmat_type, psb_desc_type, psb_spk_, &
|
||||
& amg_sprec_type, psb_ipk_
|
||||
implicit none
|
||||
type(psb_sspmat_type), intent(in), target :: a
|
||||
type(psb_sspmat_type), intent(inout), target :: a
|
||||
type(psb_desc_type), intent(inout), target :: desc_a
|
||||
class(amg_sprec_type), intent(inout), target :: prec
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
logical, intent(in), optional :: cpymat
|
||||
! character, intent(in),optional :: upd
|
||||
end subroutine amg_s_hierarchy_bld
|
||||
end interface amg_hierarchy_bld
|
||||
@@ -434,10 +437,19 @@ contains
|
||||
class(amg_sprec_type), intent(in) :: prec
|
||||
integer(psb_ipk_) :: val
|
||||
val = 0
|
||||
if (allocated(prec%precv)) then
|
||||
val = size(prec%precv)
|
||||
end if
|
||||
!!$ if (allocated(prec%precv)) then
|
||||
!!$ val = size(prec%precv)
|
||||
!!$ end if
|
||||
val = prec%nlevs
|
||||
!!$ write(0,*) ' NLEVS: ',prec%nlevs, val,size(prec%precv)
|
||||
end function amg_s_get_nlevs
|
||||
|
||||
subroutine amg_s_set_nlevs(prec,nl)
|
||||
implicit none
|
||||
class(amg_sprec_type), intent(inout) :: prec
|
||||
integer(psb_ipk_) :: nl
|
||||
prec%nlevs = nl
|
||||
end subroutine amg_s_set_nlevs
|
||||
!
|
||||
! Function returning the size of the amg_prec_type data structure
|
||||
! in bytes or in number of nonzeros of the operator(s) involved.
|
||||
@@ -508,7 +520,7 @@ contains
|
||||
|
||||
real(psb_spk_) :: num, den, nmin
|
||||
type(psb_ctxt_type) :: ctxt
|
||||
integer(psb_ipk_) :: il
|
||||
integer(psb_ipk_) :: il,nl
|
||||
|
||||
num = -sone
|
||||
den = sone
|
||||
@@ -518,7 +530,10 @@ contains
|
||||
num = prec%precv(il)%base_a%get_nzeros()
|
||||
if (num >= szero) then
|
||||
den = num
|
||||
do il=2,size(prec%precv)
|
||||
nl = prec%get_nlevs()
|
||||
!!$ write(0,*) 'Inside cmp_compl ',nl,size(prec%precv)
|
||||
do il=2, nl
|
||||
!!$ write(0,*) ' ',il,associated(prec%precv(il)%base_a)
|
||||
num = num + max(0,prec%precv(il)%base_a%get_nzeros())
|
||||
end do
|
||||
end if
|
||||
@@ -549,7 +564,6 @@ contains
|
||||
end function amg_s_get_avg_cr
|
||||
|
||||
subroutine amg_s_cmp_avg_cr(prec)
|
||||
|
||||
implicit none
|
||||
class(amg_sprec_type), intent(inout) :: prec
|
||||
|
||||
@@ -557,17 +571,18 @@ contains
|
||||
type(psb_ctxt_type) :: ctxt
|
||||
integer(psb_ipk_) :: il, nl, iam, np
|
||||
|
||||
|
||||
avgcr = szero
|
||||
nl = prec%get_nlevs()
|
||||
do il=2,nl
|
||||
if (prec%precv(il)%base_desc%is_ok()) then
|
||||
ctxt = prec%precv(il)%base_desc%get_ctxt()
|
||||
call psb_info(ctxt,iam,np)
|
||||
if (iam >=0) avgcr = avgcr + max(szero,prec%precv(il)%szratio)
|
||||
end if
|
||||
end do
|
||||
avgcr = avgcr / (nl-1)
|
||||
ctxt = prec%ctxt
|
||||
call psb_info(ctxt,iam,np)
|
||||
if (allocated(prec%precv)) then
|
||||
nl = size(prec%precv)
|
||||
do il=2,nl
|
||||
avgcr = avgcr + max(szero,prec%precv(il)%szratio)
|
||||
end do
|
||||
avgcr = avgcr / (nl-1)
|
||||
end if
|
||||
call psb_sum(ctxt,avgcr)
|
||||
prec%ag_data%avg_cr = avgcr/np
|
||||
end subroutine amg_s_cmp_avg_cr
|
||||
@@ -585,9 +600,7 @@ contains
|
||||
! error code.
|
||||
!
|
||||
subroutine amg_sprecfree(p,info)
|
||||
|
||||
implicit none
|
||||
|
||||
! Arguments
|
||||
type(amg_sprec_type), intent(inout) :: p
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
@@ -613,9 +626,7 @@ contains
|
||||
end subroutine amg_sprecfree
|
||||
|
||||
subroutine amg_s_prec_free(prec,info)
|
||||
|
||||
implicit none
|
||||
|
||||
! Arguments
|
||||
class(amg_sprec_type), intent(inout) :: prec
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
@@ -647,9 +658,7 @@ contains
|
||||
end subroutine amg_s_prec_free
|
||||
|
||||
subroutine amg_s_smoothers_free(prec,info)
|
||||
|
||||
implicit none
|
||||
|
||||
! Arguments
|
||||
class(amg_sprec_type), intent(inout) :: prec
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
@@ -666,7 +675,7 @@ contains
|
||||
end if
|
||||
|
||||
if (allocated(prec%precv)) then
|
||||
do i=1,size(prec%precv)
|
||||
do i=1,prec%get_nlevs()
|
||||
call prec%precv(i)%free_smoothers(info)
|
||||
end do
|
||||
end if
|
||||
@@ -680,9 +689,7 @@ contains
|
||||
end subroutine amg_s_smoothers_free
|
||||
|
||||
subroutine amg_s_hierarchy_free(prec,info)
|
||||
|
||||
implicit none
|
||||
|
||||
! Arguments
|
||||
class(amg_sprec_type), intent(inout) :: prec
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
@@ -709,7 +716,6 @@ contains
|
||||
|
||||
end subroutine amg_s_hierarchy_free
|
||||
|
||||
|
||||
!
|
||||
! Top level methods.
|
||||
!
|
||||
@@ -774,7 +780,6 @@ contains
|
||||
|
||||
end subroutine amg_s_apply1_vect
|
||||
|
||||
|
||||
subroutine amg_s_apply2v(prec,x,y,desc_data,info,trans,work)
|
||||
implicit none
|
||||
type(psb_desc_type),intent(in) :: desc_data
|
||||
@@ -839,7 +844,6 @@ contains
|
||||
subroutine amg_s_dump(prec,info,istart,iend,iproc,prefix,head,&
|
||||
& ac,rp,smoother,solver,tprol,&
|
||||
& global_num)
|
||||
|
||||
implicit none
|
||||
class(amg_sprec_type), intent(in) :: prec
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
@@ -856,7 +860,7 @@ contains
|
||||
info = 0
|
||||
ctxt = prec%ctxt
|
||||
call psb_info(ctxt,iam,np)
|
||||
iln = size(prec%precv)
|
||||
iln = prec%get_nlevs()
|
||||
if (present(istart)) then
|
||||
il1 = max(1,istart)
|
||||
else
|
||||
@@ -880,7 +884,6 @@ contains
|
||||
end subroutine amg_s_dump
|
||||
|
||||
subroutine amg_s_cnv(prec,info,amold,vmold,imold)
|
||||
|
||||
implicit none
|
||||
class(amg_sprec_type), intent(inout) :: prec
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
@@ -892,7 +895,7 @@ contains
|
||||
|
||||
info = psb_success_
|
||||
if (allocated(prec%precv)) then
|
||||
do i=1,size(prec%precv)
|
||||
do i=1,prec%get_nlevs()
|
||||
if (info == psb_success_ ) &
|
||||
& call prec%precv(i)%cnv(info,amold=amold,vmold=vmold,imold=imold)
|
||||
end do
|
||||
@@ -901,7 +904,6 @@ contains
|
||||
end subroutine amg_s_cnv
|
||||
|
||||
subroutine amg_s_clone(prec,precout,info)
|
||||
|
||||
implicit none
|
||||
class(amg_sprec_type), intent(inout) :: prec
|
||||
class(psb_sprec_type), intent(inout) :: precout
|
||||
@@ -913,7 +915,6 @@ contains
|
||||
end subroutine amg_s_clone
|
||||
|
||||
subroutine amg_s_inner_clone(prec,precout,info)
|
||||
|
||||
implicit none
|
||||
class(amg_sprec_type), intent(inout) :: prec
|
||||
class(psb_sprec_type), target, intent(inout) :: precout
|
||||
@@ -929,8 +930,9 @@ contains
|
||||
pout%ctxt = prec%ctxt
|
||||
pout%ag_data = prec%ag_data
|
||||
pout%outer_sweeps = prec%outer_sweeps
|
||||
pout%nlevs = prec%nlevs
|
||||
if (allocated(prec%precv)) then
|
||||
ln = size(prec%precv)
|
||||
ln = prec%get_nlevs()
|
||||
allocate(pout%precv(ln),stat=info)
|
||||
if (info /= psb_success_) goto 9999
|
||||
if (ln >= 1) then
|
||||
@@ -938,6 +940,7 @@ contains
|
||||
end if
|
||||
do lev=2, ln
|
||||
if (info /= psb_success_) exit
|
||||
!!$ write(0,*) 'Inner_clone must be checked and reimplemented! '
|
||||
call prec%precv(lev)%clone(pout%precv(lev),info)
|
||||
if (info == psb_success_) then
|
||||
pout%precv(lev)%base_a => pout%precv(lev)%ac
|
||||
@@ -1002,7 +1005,7 @@ contains
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
class(psb_s_base_vect_type), intent(in), optional :: vmold
|
||||
!
|
||||
! In MLD the DESC optional argument is ignored, since
|
||||
! In AMG the DESC optional argument is ignored, since
|
||||
! the necessary info is contained in the various entries of the
|
||||
! PRECV component.
|
||||
type(psb_desc_type), intent(in), optional :: desc
|
||||
@@ -1017,7 +1020,7 @@ contains
|
||||
if (psb_errstatus_fatal()) then
|
||||
info = psb_err_internal_error_; goto 9999
|
||||
end if
|
||||
nlev = size(prec%precv)
|
||||
nlev = prec%get_nlevs()
|
||||
level = 1
|
||||
do level = 1, nlev
|
||||
call prec%precv(level)%allocate_wrk(info,vmold=vmold)
|
||||
@@ -1040,7 +1043,6 @@ contains
|
||||
subroutine amg_s_free_wrk(prec,info)
|
||||
use psb_base_mod
|
||||
implicit none
|
||||
|
||||
! Arguments
|
||||
class(amg_sprec_type), intent(inout) :: prec
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
@@ -1057,7 +1059,7 @@ contains
|
||||
end if
|
||||
|
||||
if (allocated(prec%precv)) then
|
||||
nlev = size(prec%precv)
|
||||
nlev = prec%get_nlevs()
|
||||
do level = 1, nlev
|
||||
call prec%precv(level)%free_wrk(info)
|
||||
end do
|
||||
|
||||
+262
-206
@@ -20,7 +20,7 @@
|
||||
! documentation and/or other materials provided with the distribution.
|
||||
! 3. The name of the AMG4PSBLAS group or the names of its contributors may
|
||||
! not be used to endorse or promote products derived from this
|
||||
! software without specific written permission.
|
||||
! software without specific prior written permission.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
@@ -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(inout), 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)
|
||||
|
||||
|
||||
@@ -20,7 +20,7 @@
|
||||
! documentation and/or other materials provided with the distribution.
|
||||
! 3. The name of the AMG4PSBLAS group or the names of its contributors may
|
||||
! not be used to endorse or promote products derived from this
|
||||
! software without specific written permission.
|
||||
! software without specific prior written permission.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
|
||||
@@ -20,7 +20,7 @@
|
||||
! documentation and/or other materials provided with the distribution.
|
||||
! 3. The name of the AMG4PSBLAS group or the names of its contributors may
|
||||
! not be used to endorse or promote products derived from this
|
||||
! software without specific written permission.
|
||||
! software without specific prior written permission.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
@@ -103,7 +103,7 @@ module amg_z_ainv_solver
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
type(psb_zspmat_type), intent(in), target :: a
|
||||
type(psb_zspmat_type), intent(inout), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_z_ainv_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
@@ -225,7 +225,7 @@ module amg_z_ainv_solver
|
||||
import :: psb_desc_type, psb_zspmat_type, psb_z_base_sparse_mat, &
|
||||
& psb_d_vect_type, psb_z_base_vect_type, psb_dpk_, psb_ipk_
|
||||
implicit none
|
||||
type(psb_zspmat_type), intent(in), target :: a
|
||||
type(psb_zspmat_type), intent(inout), target :: a
|
||||
integer(psb_ipk_), intent(in) :: fillin,alg
|
||||
real(psb_dpk_), intent(in) :: thresh
|
||||
type(psb_zspmat_type), intent(inout) :: wmat, zmat
|
||||
|
||||
@@ -20,7 +20,7 @@
|
||||
! documentation and/or other materials provided with the distribution.
|
||||
! 3. The name of the AMG4PSBLAS group or the names of its contributors may
|
||||
! not be used to endorse or promote products derived from this
|
||||
! software without specific written permission.
|
||||
! software without specific prior written permission.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
@@ -230,7 +230,7 @@ module amg_z_as_smoother
|
||||
& psb_desc_type, psb_z_base_sparse_mat, psb_ipk_,&
|
||||
& psb_i_base_vect_type
|
||||
implicit none
|
||||
type(psb_zspmat_type), intent(in), target :: a
|
||||
type(psb_zspmat_type), intent(inout), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_z_as_smoother_type), intent(inout) :: sm
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
Some files were not shown because too many files have changed in this diff Show More
Reference in New Issue
Block a user