[UPDATE] Modified psb_gedto_test adding utils to use in all kernels test.

test_dev
Stack-1 10 months ago
commit f82a911fb6

@ -26,7 +26,6 @@ set_version(
GIT_DESCRIBE_VAR full_git_describe
CUSTOM_VERSION_FILE "${CMAKE_SOURCE_DIR}/.VERSION")
message( STATUS "Building PSBLAS1 version: ${full_git_describe}" )
#------------------------------------------
# Name project and specify source languages
#------------------------------------------
@ -76,6 +75,14 @@ else()
)
endif()
#----------------------------------------------------
# Define -frecursive for GNU Fortran Compiler
#----------------------------------------------------
if ("${CMAKE_Fortran_COMPILER_ID}" MATCHES "GNU" )
set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -frecursive")
message(STATUS "GNU Fortran COMPILER ${CMAKE_Fortran_FLAGS};")
endif()
message(STATUS "cmake flags? ${CMAKE_Fortran_FLAGS};")
@ -83,53 +90,78 @@ endif()
# Fortran name mangling introspection
#------------------------------------
include("${CMAKE_CURRENT_LIST_DIR}/cmake/CapitalizeString.cmake")
include(FortranCInterface)
CapitalizeString(${FortranCInterface_GLOBAL__CASE} fc_case)
message(STATUS "Name mangling capitalization: ${fc_case}")
message(STATUS "Name mangling fortran global suffix underscore: ${FortranCInterface_GLOBAL__SUFFIX}")
if(FortranCInterface_GLOBAL__SUFFIX STREQUAL "")
add_compile_options("-D${fc_case}Case")
elseif(FortranCInterface_GLOBAL__SUFFIX STREQUAL "_")
add_compile_options("-D${fc_case}Underscore")
elseif(FortranCInterface_GLOBAL__SUFFIX STREQUAL "__")
add_compile_options("-D${fc_case}DoubleUnderscore")
else()
message( FATAL_ERROR "Fortran name mangling suffix, \'${FortranCInterface_GLOBAL__SUFFIX}\', unknown to PSBLAS")
endif()
message(STATUS "win? ${WIN32};")
if(TRUE )#NOT ${WIN32})
#include(FortranCInterface)
#CapitalizeString(${FortranCInterface_GLOBAL__CASE} fc_case)
#message(STATUS "Name mangling capitalization: ${fc_case}")
#message(STATUS "Name mangling fortran global suffix underscore: ${FortranCInterface_GLOBAL__SUFFIX}")
#if(FortranCInterface_GLOBAL__SUFFIX STREQUAL "")
# add_compile_options("-D${fc_case}Case")
#elseif(FortranCInterface_GLOBAL__SUFFIX STREQUAL "_")
# add_compile_options("-D${fc_case}Underscore")
#elseif(FortranCInterface_GLOBAL__SUFFIX STREQUAL "__")
# add_compile_options("-D${fc_case}DoubleUnderscore")
#else()
# message( FATAL_ERROR "Fortran name mangling suffix, \'${FortranCInterface_GLOBAL__SUFFIX}\', unknown to PSBLAS")
#endif()
# message(STATUS "win? ${WIN32};")
#if(TRUE)#NOT ${WIN32})
#previous check did not work if WIN32 is empty string
#----------------------------------------------
# Determine system endian-ness and pointer size
#----------------------------------------------
include(TestBigEndian)
TEST_BIG_ENDIAN(IS_BIG_ENDIAN)
if(IS_BIG_ENDIAN)
message( STATUS "System appears to be big endian.")
else()
message( STATUS "System appears to be little endian.")
add_compile_options(-DLittleEndian)
endif()
include(CheckTypeSize)
CHECK_TYPE_SIZE("void *" VOID_P_SIZE LANGUAGE C)
if(${VOID_P_SIZE} EQUAL 8)
add_compile_options(-DPtr64Bits)
endif()
message(STATUS "Have 64bit pointers")
# include(TestBigEndian)
# TEST_BIG_ENDIAN(IS_BIG_ENDIAN)
# if(IS_BIG_ENDIAN)
# message( STATUS "System appears to be big endian.")
# else()
# message( STATUS "System appears to be little endian.")
# add_compile_options(-DLittleEndian)
# endif()
# include(CheckTypeSize)
# CHECK_TYPE_SIZE("void *" VOID_P_SIZE LANGUAGE C)
# if(${VOID_P_SIZE} EQUAL 8)
# add_compile_options(-DPtr64Bits)
# endif()
# message(STATUS "Have 64bit pointers")
#add define values for integer size (IPKx) and long size (LPKx)
CHECK_TYPE_SIZE("int" INT_SIZE LANGUAGE C)
CHECK_TYPE_SIZE("long" LONG_SIZE LANGUAGE C)
message(STATUS "INT SIZE ${INT_SIZE}")
#endif()
add_compile_options(-DIPK${INT_SIZE})
add_compile_options(-DLPK${LONG_SIZE})
message(STATUS "Using compiler ${CMAKE_C_COMPILER};")
# Set default values for IPK_SIZE and LPK_SIZE
set(DEFAULT_IPK_SIZE 4)
set(DEFAULT_LPK_SIZE 8)
# Allow user to override with command line definitions
if(NOT DEFINED CMAKE_PSB_IPK)
set(CMAKE_PSB_IPK ${DEFAULT_IPK_SIZE} CACHE STRING "Size of IPK (default: 4)")
endif()
if(NOT DEFINED CMAKE_PSB_LPK)
set(CMAKE_PSB_LPK ${DEFAULT_LPK_SIZE} CACHE STRING "Size of LPK (default: 8)")
endif()
# Use the passed values
set(IPK_SIZE ${CMAKE_PSB_IPK})
set(LPK_SIZE ${CMAKE_PSB_LPK})
# Define IPKDEF and LPKDEF based on the sizes
set(PSB_IPKDEF "#define PSB_IPK${IPK_SIZE}")
set(PSB_LPKDEF "#define PSB_LPK${LPK_SIZE}")
# Output the definitions for verification
message(STATUS "Using IPKDEF: ${PSB_IPKDEF}")
message(STATUS "Using LPKDEF: ${PSB_LPKDEF}")
#add_compile_options(-DPSB_IPK${IPK_SIZE})
#add_compile_options(-DPSB_LPK${LPK_SIZE})
# Add PSB_IPK/LPK flag only for fortran files.
set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -DPSB_IPK${IPK_SIZE}")
set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -DPSB_LPK${LPK_SIZE}")
@ -149,7 +181,8 @@ end
SRC_EXT f90
)
if(HAVE_MOVE_ALLOC)
add_compile_options(-DHAVE_MOVE_ALLOC)
#add_compile_options(-DHAVE_MOVE_ALLOC)
set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -DHAVE_MOVE_ALLOC")
message(STATUS "-DHAVE_MOVE_ALLOC")
endif()
CHECK_Fortran_SOURCE_COMPILES(
@ -158,8 +191,9 @@ CHECK_Fortran_SOURCE_COMPILES(
SRC_EXT f90
)
if(HAVE_VOLATILE)
add_compile_options(-DHAVE_VOLATILE)
message(STATUS "-DHAVE_VOLATILE")
#add_compile_options(-DPSB_HAVE_VOLATILE)
set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -DPSB_HAVE_VOLATILE")
message(STATUS "-DPSB_HAVE_VOLATILE")
endif()
CHECK_Fortran_SOURCE_COMPILES(
"use ISO_FORTRAN_ENV ; end"
@ -167,8 +201,9 @@ CHECK_Fortran_SOURCE_COMPILES(
SRC_EXT f90
)
if(HAVE_ISO_FORTRAN_ENV)
add_compile_options(-DHAVE_ISO_FORTRAN_ENV)
message(STATUS "-DHAVE_ISO_FORTRAN_ENV")
#add_compile_options(-DPSB_HAVE_ISO_FORTRAN_ENV)
set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -DPSB_HAVE_ISO_FORTRAN_ENV")
message(STATUS "-DPSB_HAVE_ISO_FORTRAN_ENV")
endif()
CHECK_Fortran_SOURCE_COMPILES(
"flush(5); end"
@ -176,8 +211,9 @@ CHECK_Fortran_SOURCE_COMPILES(
SRC_EXT f90
)
if(HAVE_FLUSH_STMT)
add_compile_options(-DHAVE_FLUSH_STMT)
message(STATUS "-DHAVE_FLUSH_STMT")
#add_compile_options(-DPSB_HAVE_FLUSH_STMT)
set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -DPSB_HAVE_FLUSH_STMT")
message(STATUS "-DPSB_HAVE_FLUSH_STMT")
endif()
CHECK_Fortran_SOURCE_COMPILES(
"
@ -202,8 +238,9 @@ end program"
SRC_EXT f90
)
if(HAVE_FINAL)
add_compile_options(-DHAVE_FINAL)
message(STATUS "-DHAVE_FINAL")
# add_compile_options(-DPSB_HAVE_FINAL)
set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -DPSB_HAVE_FINAL")
message(STATUS "-DPSB_HAVE_FINAL")
endif()
CHECK_Fortran_SOURCE_COMPILES(
"
@ -222,8 +259,9 @@ end program"
HAVE_MOLD
SRC_EXT f90)
if(HAVE_MOLD)
add_compile_options(-DHAVE_MOLD)
message(STATUS "-DHAVE_MOLD")
# add_compile_options(-DPSB_HAVE_MOLD)
set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -DPSB_HAVE_MOLD")
message(STATUS "-DPSB_HAVE_MOLD")
endif()
CHECK_Fortran_SOURCE_COMPILES(
"
@ -239,8 +277,9 @@ end program "
HAVE_EXTENDS_TYPE_OF
SRC_EXT f90)
if(HAVE_EXTENDS_TYPE_OF)
add_compile_options(-DHAVE_EXTENDS_TYPE_OF)
message(STATUS "-DHAVE_EXTENDS_TYPE_OF")
# add_compile_options(-DPSB_HAVE_EXTENDS_TYPE_OF)
set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -DPSB_HAVE_EXTENDS_TYPE_OF")
message(STATUS "-DPSB_HAVE_EXTENDS_TYPE_OF")
endif()
CHECK_Fortran_SOURCE_COMPILES(
"
@ -261,8 +300,9 @@ end program"
HAVE_SAME_TYPE_AS
SRC_EXT f90)
if(HAVE_SAME_TYPE_AS)
add_compile_options(-DHAVE_SAME_TYPE_AS)
message(STATUS "-DHAVE_SAME_TYPE_AS")
# add_compile_options(-DPSB_HAVE_SAME_TYPE_AS)
set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -DPSB_HAVE_SAME_TYPE_AS")
message(STATUS "-DPSB_HAVE_SAME_TYPE_AS")
endif()
#----------------------------------------------------------------------------
@ -307,18 +347,19 @@ https://github.com/sourceryinstitute/OpenCoarrays/issues/317.
include_directories(BEFORE ${MPI_C_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(-DMPI_MOD)
message(STATUS "-DMPI_MOD")
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(SERIAL_MPI OFF)
set(PSB_SERIAL_MPI OFF)
else()
message(STATUS "MPI not found, serial ahead")
add_compile_options(-DSERIAL_MPI)
add_compile_options(-DMPI_MOD)
set(SERIAL_MPI ON)
add_compile_options(-DPSB_SERIAL_MPI)
add_compile_options(-DPSB_MPI_MOD)
set(PSB_SERIAL_MPI ON)
set(CSERIALMPI "#define PSB_SERIAL_MPI")
endif()
#-------------------------------------------------------
@ -338,7 +379,9 @@ if(NOT APPLE)
endif()
find_package(BLAS REQUIRED)
find_package(LAPACK REQUIRED)
add_compile_options(-DHAVE_LAPACK)
#add_compile_options(-DPSB_HAVE_LAPACK)
set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -DPSB_HAVE_LAPACK")
#--------------------------------
@ -347,14 +390,187 @@ add_compile_options(-DHAVE_LAPACK)
include(${CMAKE_CURRENT_LIST_DIR}/cmake/FindMETIS.cmake)
find_package(METIS)
if(METIS_FOUND)
message(STATUS "METIS PATH ${METIS_INCLUDES} and metis libraries ${METIS_LIBRARIES}")
# Make sure this path is correct
# set(METISINCFILE "metis.h") # Adjust this to your actual path
# Specify the configuration file
# set(HEADER_TEMPLATE "${CMAKE_CURRENT_SOURCE_DIR}/util/psb_metis_int.h.in")
# set(HEADER_OUTPUT "${CMAKE_CURRENT_BINARY_DIR}/include/psb_metis_int.h")
# Configure the header file
#configure_file(${HEADER_TEMPLATE} ${HEADER_OUTPUT} @ONLY)
# Check for real sizes using try_compile
include(CheckCSourceCompiles)
# Function to check the size of a type
function(check_metis_real_type type_name)
set(source_code "
#include <metis.h>
#include <stdio.h>
int main() {
printf(\"%zu\\n\", sizeof(${type_name}));
return 0;
}")
# Create a temporary source file
file(WRITE "${CMAKE_BINARY_DIR}/CMakeFiles/CMakeTmp/test_size.c" "${source_code}")
# Try to compile it
try_compile(COMPILER_RESULT "${CMAKE_BINARY_DIR}/CMakeFiles/CMakeTmp"
"${CMAKE_BINARY_DIR}/CMakeFiles/CMakeTmp/test_size.c")
# Check the result and read the output
if (COMPILER_RESULT)
execute_process(COMMAND "${CMAKE_BINARY_DIR}/CMakeFiles/CMakeTmp/test_size"
OUTPUT_VARIABLE type_size)
string(STRIP "${type_size}" type_size)
if (type_name STREQUAL "float")
set(PSB_METIS_REAL_32 "${type_size}" PARENT_SCOPE)
# add_definitions(-DPSB_METIS_REAL_32)
set(CREALMETIS "#define PSB_METIS_REAL_32" PARENT_SCOPE)
elseif (type_name STREQUAL "double")
set(PSB_METIS_REAL_64 "${type_size}" PARENT_SCOPE)
#add_definitions(-DPSB_METIS_REAL_64)
set(CREALMETIS "#define PSB_METIS_REAL_64" PARENT_SCOPE)
endif()
else()
message(WARNING "Failed to compile test for type size: ${type_name}")
endif()
endfunction()
# Check for both float and double
check_metis_real_type(float)
check_metis_real_type(double)
# Set HAVE_METIS if METIS is found
#add_compile_options(-DPSB_HAVE_METIS)
# set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -DPSB_HAVE_METIS")
# Determine METIS_INDEX based on real type sizes
if(DEFINED PSB_METIS_REAL_32)
set(METIS_INDEX 32)
elseif(DEFINED PSB_METIS_REAL_64)
set(METIS_INDEX 64)
else()
message(WARNING "Neither METIS_REAL_32 nor METIS_REAL_64 is defined.")
set(METIS_INDEX 64) # Default to 64 if not defined
endif()
# Check conditions for LPK_SIZE and METIS_INDEX
if(LPK_SIZE STREQUAL "4")
if(METIS_INDEX STREQUAL "64")
# Mismatch between METIS size and PSBLAS LPK
message(FATAL " Mismatch between metis ${METIS_INDEX} size and psblas LPK size ${LPK_SIZE}")
set(METIS_FOUND FALSE)
endif()
endif()
if(LPK_SIZE STREQUAL "8")
if(METIS_INDEX STREQUAL "32")
# Mismatch between METIS size and PSBLAS LPK
message(FATAL " Mismatch between metis ${METIS_INDEX} size and psblas LPK size ${LPK_SIZE}")
set(METIS_FOUND FALSE)
endif()
endif()
if(METIS_FOUND)
# Make sure this path is correct
set(METISINCFILE "metis.h") # Adjust this to your actual path
# Specify the configuration file
set(HEADER_TEMPLATE "${CMAKE_CURRENT_SOURCE_DIR}/util/psb_metis_int.h.in")
set(HEADER_OUTPUT "${CMAKE_CURRENT_BINARY_DIR}/include/psb_metis_int.h")
# Configure the header file
configure_file(${HEADER_TEMPLATE} ${HEADER_OUTPUT} @ONLY)
# Set HAVE_METIS if METIS is found and coherent with the system settings
#add_compile_options(-DPSB_HAVE_METIS)
set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -DPSB_HAVE_METIS")
set(CHAVEMETIS "#define PSB_HAVE_METIS")
set(CINTMETIS "#define PSB_METIS_${METIS_INDEX}")
# set(CREALMETIS "#define PSB_METIS_REAL_${LPK_SIZE}")
# Configure the header file
configure_file(${HEADER_TEMPLATE} ${HEADER_OUTPUT} @ONLY)
# Set HAVE_METIS if METIS is found
#add_compile_options(-DPSB_HAVE_METIS)
set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -DPSB_HAVE_METIS")
endif()
endif()
#---------------------------------------------------
# Use standardized GNU install directory conventions
#---------------------------------------------------
include(GNUInstallDirs)
#set(mod_dir_tail "${${CMAKE_PROJECT_NAME}_dist_string}_${CMAKE_Fortran_COMPILER_ID}-${CMAKE_Fortran_COMPILER_VERSION}")
set(CMAKE_RUNTIME_OUTPUT_DIRECTORY "${CMAKE_BINARY_DIR}/${CMAKE_INSTALL_BINDIR}/${${CMAKE_PROJECT_NAME}_dist_string}-tests")
set(CMAKE_LIBRARY_OUTPUT_DIRECTORY "${CMAKE_BINARY_DIR}/${CMAKE_INSTALL_LIBDIR}")
set(CMAKE_ARCHIVE_OUTPUT_DIRECTORY "${CMAKE_BINARY_DIR}/${CMAKE_INSTALL_LIBDIR}")
set(CMAKE_LIBRARY_OUTPUT_DIRECTORY "${CMAKE_BINARY_DIR}")
set(CMAKE_ARCHIVE_OUTPUT_DIRECTORY "${CMAKE_BINARY_DIR}")
#set(CMAKE_INSTALL_LIBDIR "lib" CACHE STRING "Library install directory")
#set(CMAKE_INSTALL_INCLUDEDIR "include" CACHE STRING "Include directory")
#set(CMAKE_INSTALL_MODULDIR "modules" CACHE STRING "Modules directory")
#Ser variables exportable for other projects
message(STATUS "Initial CMAKE_INSTALL_LIBDIR: ${CMAKE_INSTALL_LIBDIR}")
set(PSB_CMAKE_INSTALL_PREFIX ${CMAKE_INSTALL_PREFIX})
if(NOT PSB_CMAKE_INSTALL_LIBDIR)
message(STATUS "CMAKE_INSTALL_LIBDIR is set to default value lib")
set(CMAKE_INSTALL_LIBDIR "lib" CACHE STRING "Library install directory" FORCE)
set(PSB_CMAKE_INSTALL_LIBDIR ${CMAKE_INSTALL_LIBDIR})
else()
set(CMAKE_INSTALL_LIBDIR ${PSB_CMAKE_INSTALL_LIBDIR})
message(STATUS "CMAKE_INSTALL_LIBDIR is set to: ${CMAKE_INSTALL_LIBDIR}")
endif()
if(NOT PSB_CMAKE_INSTALL_INCLUDEDIR)
message(STATUS "CMAKE_INSTALL_INCLUDEDIR is set to default value lib")
set(CMAKE_INSTALL_INCLUDEDIR "include" CACHE STRING "Include directory" FORCE)
set(PSB_CMAKE_INSTALL_INCLUDEDIR ${CMAKE_INSTALL_INCLUDEDIR})
else()
set(CMAKE_INSTALL_INCLUDEDIR ${PSB_CMAKE_INSTALL_INCLUDEDIR})
message(STATUS "CMAKE_INSTALL_INCLUDEDIR is set to: ${CMAKE_INSTALL_INCLUDEDIR}")
endif()
if(NOT PSB_CMAKE_INSTALL_MODULDIR)
message(STATUS "CMAKE_INSTALL_MODULDIR is set to default value lib")
set(CMAKE_INSTALL_MODULDIR "modules" CACHE STRING "Modules directory" FORCE)
set(PSB_CMAKE_INSTALL_MODULDIR ${CMAKE_INSTALL_MODULDIR})
else()
set(CMAKE_INSTALL_MODULDIR ${PSB_CMAKE_INSTALL_MODULDIR})
message(STATUS "CMAKE_INSTALL_MODULDIR is set to: ${CMAKE_INSTALL_MODULDIR}")
endif()
#-----------------------------------
# Turn on testing/ctest capabilities
@ -386,7 +602,7 @@ define_property(TARGET
install(EXPORT ${CMAKE_PROJECT_NAME}-targets
FILE ${CMAKE_PROJECT_NAME}Config.cmake
NAMESPACE ${CMAKE_PROJECT_NAME}::
DESTINATION "${CMAKE_INSTALL_LIBDIR}/cmake"
DESTINATION "${CMAKE_INSTALL_LIBDIR}/cmake/"
)
@ -397,15 +613,16 @@ 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(
FILES
"${CMAKE_CURRENT_BINARY_DIR}/CMakeFiles/${CMAKE_PROJECT_NAME}Config.cmake"
"${CMAKE_CURRENT_BINARY_DIR}/${CMAKE_PROJECT_NAME}ConfigVersion.cmake"
"${CMAKE_CURRENT_BINARY_DIR}/${CMAKE_PROJECT_NAME}Targets.cmake"
DESTINATION
"${CMAKE_INSTALL_LIBDIR}/cmake/psblas"
"${CMAKE_INSTALL_LIBDIR}/cmake/${CMAKE_PROJECT_NAME}"
)
#------------------------------------------
@ -434,6 +651,82 @@ if(MPI_FOUND)
endif()
endif()
# Optionally check for CUDA requirement
option(PSB_BUILD_CUDA "Build CUDA code" OFF)
if(IPK_SIZE EQUAL 8)
set(PSB_BUILD_CUDA OFF)
message(STATUS "IPK8 is not compatible with CUDA. Cuda is now OFF ${PSB_BUILD_CUDA}")
endif()
if(PSB_BUILD_CUDA)
#if(NOT DEFINED PSB_CUDA_PATH)
# set(PSB_CUDA_PATH "/opt/cuda/12.8")
#endif()
# Include the CMakeLists for the cuda library
include(${CMAKE_CURRENT_LIST_DIR}/cuda/CMakeLists.txt)
include_directories("${PSB_CUDA_PATH}/include")
message(STATUS "${PSB_CUDA_PATH}")
# find_package(CUDA REQUIRED)
enable_language(CUDA)
message(STATUS "Enabled CUDA ${CMAKE_CUDA_COMPILER_VERSION} ${CMAKE_CUDA_ARCHITECTURES};; ${CMAKE_CUDA_HOST_COMPILER_VERSION};")
find_package(CUDAToolkit)
message(STATUS "Enabled CUDA throguh find ${CUDAToolkit_VERSION_MAJOR} ${CUDAToolkit_VERSION};; ${CUDAToolkit_VERSION_MINOR};")
#compute cuda versio for psblas
math(EXPR PSB_CUDA_VERSION "${CUDAToolkit_VERSION_MAJOR} * 1000 + ${CUDAToolkit_VERSION_MINOR} * 10")
message(STATUS "cuda version called has given ${PSB_CUDA_VERSION}:")
# Check for CUDA version
# set(PSB_CUDA_VERSION 12800)
if(PSB_CUDA_VERSION)
message(STATUS "CUDA version: ${PSB_CUDA_VERSION}")
# Define macros for CUDA version
# add_definitions(-DPSB_HAVE_CUDA)
# add_definitions(-DPSB_CUDA_VERSION=${PSB_CUDA_VERSION})
# math(EXPR PSB_CUDA_SHORT_VERSION "${PSB_CUDA_VERSION} / 1000")
# add_definitions(-DPSB_CUDA_SHORT_VERSION=${PSB_CUDA_SHORT_VERSION})
set(PSB_CUDA_SHORT_VERSION ${CUDAToolkit_VERSION_MAJOR})
message(STATUS "cuda version called has given ${PSB_CUDA_SHORT_VERSION}:")
set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -DPSB_HAVE_CUDA")
set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -DPSB_CUDA_VERSION=${PSB_CUDA_VERSION}")
set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -DPSB_CUDA_SHORT_VERSION=${PSB_CUDA_SHORT_VERSION}")
set(CHAVECUDA "#define PSB_HAVE_CUDA")
set(CSHORTVCUDA "#define PSB_CUDA_SHORT_VERSION ${PSB_CUDA_SHORT_VERSION}")
set(CVERSIONCUDA "#define PSB_CUDA_VERSION ${PSB_CUDA_VERSION}")
else()
message(FATAL_ERROR "CUDA version not found!")
endif()
endif()
#------------------------------------------
# Configure the psb_config.h file
#------------------------------------------
message(STATUS "bin dir ${CMAKE_CURRENT_BINARY_DIR}; source dir ${CMAKE_CURRENT_SOURCE_DIR};;")
configure_file(
${CMAKE_CURRENT_SOURCE_DIR}/base/modules/psb_config.h.in
${CMAKE_CURRENT_BINARY_DIR}/include/psb_config.h
@ONLY # Replace variables only
)
#---------------------------------------
# Add the PSBLAS libraries and utilities
#---------------------------------------
@ -449,6 +742,15 @@ include(${CMAKE_CURRENT_LIST_DIR}/base/CMakeLists.txt)
include_directories("${CMAKE_BINARY_DIR}/${CMAKE_INSTALL_INCLUDEDIR}")
foreach(path IN LISTS base_header_C_files)
# Copy the header file to the include directory
file(COPY "${path}" DESTINATION "${CMAKE_BINARY_DIR}/include")
endforeach()
if(WIN32)
add_library(psb_base_C STATIC ${base_source_C_files})
target_compile_definitions(psb_base_C
@ -582,7 +884,14 @@ if(WIN32)
PUBLIC psb_util_C)
endif()
else()
if(METIS_FOUND)
foreach(file IN LISTS util_source_C_metis_files)
list(APPEND util_source_C_files file)
endforeach()
endif()
add_library(psb_util_C OBJECT ${util_source_C_files})
add_library(util ${util_source_files} $<TARGET_OBJECTS:psb_util_C>)
endif()
set_target_properties(util
@ -596,77 +905,19 @@ target_include_directories(util PUBLIC
$<BUILD_INTERFACE:${CMAKE_BINARY_DIR}/modules>
$<INSTALL_INTERFACE:modules>)
target_link_libraries(util PUBLIC base prec)
if(METIS_FOUND)
message(STATUS "METIS PATH ${METIS_INCLUDES} and metis libraries ${METIS_LIBRARIES}")
# Make sure this path is correct
set(METISINCFILE "metis.h") # Adjust this to your actual path
# Specify the configuration file
set(HEADER_TEMPLATE "${CMAKE_CURRENT_SOURCE_DIR}/util/psb_metis_int.h.in")
set(HEADER_OUTPUT "${CMAKE_CURRENT_BINARY_DIR}/include/psb_metis_int.h")
# Configure the header file
configure_file(${HEADER_TEMPLATE} ${HEADER_OUTPUT} @ONLY)
# Check for real sizes using try_compile
include(CheckCSourceCompiles)
# Function to check the size of a type
function(check_metis_real_type type_name)
set(source_code "
#include <metis.h>
#include <stdio.h>
int main() {
printf(\"%zu\\n\", sizeof(${type_name}));
return 0;
}")
# Create a temporary source file
file(WRITE "${CMAKE_BINARY_DIR}/CMakeFiles/CMakeTmp/test_size.c" "${source_code}")
# Try to compile it
try_compile(COMPILER_RESULT "${CMAKE_BINARY_DIR}/CMakeFiles/CMakeTmp"
"${CMAKE_BINARY_DIR}/CMakeFiles/CMakeTmp/test_size.c")
# Check the result and read the output
if (COMPILER_RESULT)
execute_process(COMMAND "${CMAKE_BINARY_DIR}/CMakeFiles/CMakeTmp/test_size"
OUTPUT_VARIABLE type_size)
string(STRIP "${type_size}" type_size)
if (type_name STREQUAL "float")
set(METIS_REAL_32 "${type_size}")
add_definitions(-DMETIS_REAL_32)
elseif (type_name STREQUAL "double")
set(METIS_REAL_64 "${type_size}")
add_definitions(-DMETIS_REAL_64)
endif()
else()
message(WARNING "Failed to compile test for type size: ${type_name}")
endif()
endfunction()
# Check for both float and double
check_metis_real_type(float)
check_metis_real_type(double)
# Set HAVE_METIS if METIS is found
add_compile_options(-DHAVE_METIS)
if(METIS_FOUND)
target_include_directories(util
PUBLIC ${METIS_INCLUDES})
target_include_directories(psb_util_C
PUBLIC ${METIS_INCLUDES})
target_link_libraries(util
PUBLIC ${METIS_LIBRARIES})
target_compile_definitions(psb_util_C
PUBLIC HAVE_METIS_)
target_compile_definitions(util
PUBLIC HAVE_METIS)
# target_compile_definitions(psb_util_C
# PUBLIC PSB_HAVE_METIS) #TDDO: CHECK IF THAT _ IS CORRECT
# target_compile_definitions(util
# PUBLIC PSB_HAVE_METIS)
endif()
@ -683,7 +934,7 @@ include_directories(${CMAKE_BINARY_DIR}/include)
include(${CMAKE_CURRENT_LIST_DIR}/cbind/CMakeLists.txt)
if(WIN32)
add_library(psb_cbind_C STATIC ${base_source_C_files})
add_library(psb_cbind_C STATIC ${cbind_source_C_files})
target_compile_definitions(psb_cbind_C
PRIVATE -DWIN32 -D_LIB -DWIN64)
set_target_properties(psb_cbind_C
@ -697,7 +948,8 @@ if(WIN32)
PUBLIC psb_cbind_C)
else()
add_library(cbind_C OBJECT ${cbind_source_C_files})
add_library(cbind ${cbind_source_files})
add_library(cbind ${cbind_source_files} $<TARGET_OBJECTS:cbind_C>)
endif()
@ -758,6 +1010,118 @@ message(STATUS "Copied .h files to ${CMAKE_BINARY_DIR}/include")
#########################################
####### BUILD CUDA LIBRARY ##############
#########################################
# Optionally check for CUDA requirement
#option(PSB_BUILD_CUDA "Build CUDA code" OFF)
if(PSB_BUILD_CUDA)
# if(NOT DEFINED PSB_CUDA_PATH)
# set(PSB_CUDA_PATH "/opt/cuda/12.8")
#endif()
# Include the CMakeLists for the cbind library
#include(${CMAKE_CURRENT_LIST_DIR}/cuda/CMakeLists.txt)
#include_directories("${PSB_CUDA_PATH}/include")
#message(STATUS "${PSB_CUDA_PATH}")
# find_package(CUDA REQUIRED)
#enable_language(CUDA)
# Check for CUDA version
#set(PSB_CUDA_VERSION 12800)
#if(PSB_CUDA_VERSION)
# message(STATUS "CUDA version: ${PSB_CUDA_VERSION}")
# Define macros for CUDA version
# add_definitions(-DPSB_HAVE_CUDA)
# add_definitions(-DPSB_CUDA_VERSION=${PSB_CUDA_VERSION})
#math(EXPR PSB_CUDA_SHORT_VERSION "${PSB_CUDA_VERSION} / 1000")
# add_definitions(-DPSB_CUDA_SHORT_VERSION=${PSB_CUDA_SHORT_VERSION})
#set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -DPSB_HAVE_CUDA")
#set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -DPSB_CUDA_VERSION=${PSB_CUDA_VERSION}")
#set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -DPSB_CUDA_SHORT_VERSION=${PSB_CUDA_SHORT_VERSION}")
#set(CHAVECUDA "#define PSB_HAVE_CUDA")
#set(CSHORTVCUDA "#define PSB_CUDA_SHORT_VERSION ${PSB_CUDA_SHORT_VERSION}")
#set(CVERSIONCUDA "#define PSB_CUDA_VERSION ${PSB_CUDA_VERSION}")
#else()
#message(FATAL_ERROR "CUDA version not found!")
#endif()
# Define the CUDA library
#if(WIN32)
#add_library(psb_cuda_C STATIC ${cuda_source_files})
#target_compile_definitions(psb_cuda_C
# PRIVATE -DWIN32 -D_LIB -DWIN64)
#set_target_properties(psb_cuda_C
# PROPERTIES
# LINKER_LANGUAGE C
# POSITION_INDEPENDENT_CODE TRUE)
#target_link_libraries(psb_cuda_C
# PUBLIC kernel32 user32 shell32)
#else()
#add_library(psb_cuda_C OBJECT ${cuda_source_files})
#endif()
foreach(path IN LISTS cuda_header_C_files)
# Copy the header file to the include directory
file(COPY "${path}" DESTINATION "${CMAKE_BINARY_DIR}/include")
endforeach()
message(STATUS "Copied .h files to ${CMAKE_BINARY_DIR}/include")
foreach(path IN LISTS cuda_header_cu_files)
# Copy the header file to the include directory
file(COPY "${path}" DESTINATION "${CMAKE_BINARY_DIR}/include")
endforeach()
message(STATUS "Copied .cuh files to ${CMAKE_BINARY_DIR}/include")
add_library(psb_cuda_C OBJECT ${cuda_source_C_files} ${cuda_source_cu_files})
# Create the main CUDA library
add_library(cuda ${cuda_source_files})
# Set properties for the CUDA library
set_target_properties(cuda
PROPERTIES
POSITION_INDEPENDENT_CODE TRUE
OUTPUT_NAME psb_cuda
LINKER_LANGUAGE C)
# Include directories for the CUDA library
target_include_directories(cuda PUBLIC
$<BUILD_INTERFACE:${CMAKE_BINARY_DIR}/modules> # Path for building
$<INSTALL_INTERFACE:modules> # Path for installation
#/opt/cuda/12.8/include
)
# Link with other necessary libraries
target_link_libraries(cuda PUBLIC base prec linsolve ext util)
endif()
if(MPI_FOUND)
# Copy mpi.mod from the first available path in MPI_Fortran_INCLUDE_PATH
set(MPI_MOD_COPIED FALSE)
@ -804,11 +1168,31 @@ message(STATUS "\t\t ${CMAKE_INSTALL_LIBDIR}")
# DESTINATION include
#)
install(DIRECTORY "${CMAKE_BINARY_DIR}/include" DESTINATION "include"
FILES_MATCHING PATTERN "*.h")
#install(DIRECTORY "${CMAKE_BINARY_DIR}/include" DESTINATION "include"
# FILES_MATCHING PATTERN "*.h")
#install(DIRECTORY "${CMAKE_BINARY_DIR}/modules" DESTINATION "modules"
# FILES_MATCHING PATTERN "*.mod")
#install(DIRECTORY "${CMAKE_INSTALL_PREFIX}/${CMAKE_INSTALL_INCLUDEDIR}" DESTINATION "include"
# FILES_MATCHING PATTERN "*.h")
#install(DIRECTORY "${CMAKE_INSTALL_PREFIX}/${CMAKE_INSTALL_MODULDIR}" DESTINATION "modules"
# FILES_MATCHING PATTERN "*.mod")
# Install header files
install(DIRECTORY ${CMAKE_BINARY_DIR}/include/
DESTINATION "${CMAKE_INSTALL_INCLUDEDIR}" # This will place headers in <prefix>/include
FILES_MATCHING PATTERN "*.h"
)
# Install module files
install(DIRECTORY ${CMAKE_BINARY_DIR}/modules/
DESTINATION "${CMAKE_INSTALL_MODULDIR}" # This will place .mod files in <prefix>/modules
FILES_MATCHING PATTERN "*.mod"
)
install(DIRECTORY "${CMAKE_BINARY_DIR}/modules" DESTINATION "modules"
FILES_MATCHING PATTERN "*.mod")
install(TARGETS base prec linsolve ext util cbind
@ -817,7 +1201,14 @@ install(TARGETS base prec linsolve ext util cbind
LIBRARY DESTINATION "${CMAKE_INSTALL_LIBDIR}"
)
if(PSB_BUILD_CUDA)
install(TARGETS cuda
EXPORT ${CMAKE_PROJECT_NAME}-targets
DESTINATION "${CMAKE_INSTALL_LIBDIR}"
LIBRARY DESTINATION "${CMAKE_INSTALL_LIBDIR}"
)
endif()
if(WIN32)
install(TARGETS psb_base_C
@ -834,26 +1225,67 @@ if(WIN32)
endif()
endif()
# Step 2: Create the configuration file from the template
configure_package_config_file(
"${CMAKE_CURRENT_SOURCE_DIR}/cmake/psblasConfig.cmake.in"
"${CMAKE_CURRENT_BINARY_DIR}/psblasConfig.cmake"
INSTALL_DESTINATION "${CMAKE_INSTALL_LIBDIR}/cmake/psblas"
)
# Step 3: Install the generated config files
install(FILES
"${CMAKE_CURRENT_BINARY_DIR}/psblasConfig.cmake"
"${CMAKE_CURRENT_BINARY_DIR}/psblasConfigVersion.cmake"
DESTINATION "${CMAKE_INSTALL_LIBDIR}/cmake/psblas"
)
#configure_package_config_file(
# INSTALL_DESTINATION "${CMAKE_INSTALL_PREFIX}/cmake/psblas"
#)
#install(FILES
# "${CMAKE_CURRENT_BINARY_DIR}/psblasConfig.cmake"
# "${CMAKE_CURRENT_BINARY_DIR}/psblasConfigVersion.cmake"
# DESTINATION "${CMAKE_INSTALL_PREFIX}/cmake/psblas"
#)
# Step 4: Export targets so that the build directory can be used directly
export(
EXPORT ${CMAKE_PROJECT_NAME}-targets
FILE "${CMAKE_CURRENT_BINARY_DIR}/psblasTargets.cmake"
NAMESPACE psblas::
NAMESPACE ${CMAKE_PROJECT_NAME}::
)
# Set the installation directory for the test files
set(INSTALL_TEST_DIR "${CMAKE_INSTALL_PREFIX}/samples" CACHE PATH "Installation directory for sample files")
function(install_directory_recursive source_dir install_base_dir) # Function to install a directory and its subdirectories recursively
file(GLOB_RECURSE ALL_FILES RELATIVE "${CMAKE_CURRENT_SOURCE_DIR}/${source_dir}" "${source_dir}/*")
foreach(FILE_PATH IN LISTS ALL_FILES)
# Construct the full source and destination paths
set(FULL_SOURCE_PATH "${CMAKE_CURRENT_SOURCE_DIR}/${source_dir}/${FILE_PATH}")
set(FULL_INSTALL_PATH "${install_base_dir}/${FILE_PATH}")
# Check if it's a directory
if(IS_DIRECTORY "${FULL_SOURCE_PATH}")
# Create the directory in the install destination
file(MAKE_DIRECTORY "${FULL_INSTALL_PATH}")
else()
# Install the file
install(FILES "${FULL_SOURCE_PATH}" DESTINATION "${install_base_dir}" RENAME "${FILE_PATH}")
endif()
endforeach()
endfunction()
# Install cbind/test directory
install_directory_recursive(cbind/test "${INSTALL_TEST_DIR}/cbind")
# Install test/fileread directory
install_directory_recursive(test/fileread "${INSTALL_TEST_DIR}/fileread")
# Install test/pdegen directory
install_directory_recursive(test/pdegen "${INSTALL_TEST_DIR}/pdegen")
message(STATUS "CMAKE_INSTALL_PREFIX: ${CMAKE_INSTALL_PREFIX} - ${PSB_CMAKE_INSTALL_PREFIX};")
message(STATUS "CMAKE_INSTALL_LIBDIR: ${CMAKE_INSTALL_LIBDIR} - ${PSB_CMAKE_INSTALL_LIBDIR};")
message(STATUS "CMAKE_INSTALL_INCLUDEDIR: ${CMAKE_INSTALL_INCLUDEDIR} - ${PSB_CMAKE_INSTALL_INCLUDEDIR};")
message(STATUS "CMAKE_INSTALL_MODULDIR: ${CMAKE_INSTALL_MODULDIR} - ${PSB_CMAKE_INSTALL_MODULDIR};")
#-----------------
# Add PSBLAS tests
#-----------------

@ -26,6 +26,7 @@ MPFC=@MPIFC@
MPCC=@MPICC@
FLINK=@FLINK@
CLINK=@CLINK@
LIBS=@LIBS@
FLIBS=@FLIBS@

@ -61,15 +61,15 @@ prerequisites (see also SERIAL below):
http://math-atlas.sourceforge.net/
3. We have had good results with the METIS library, from
http://www-users.cs.umn.edu/~karypis/metis/metis/main.html.
https://github.com/KarypisLab/METIS.
This is optional; it is used in the util and test/fileread
directories but only if you specify `--with-metis`.
4. If you have the AMD package of Davis, Duff and Amestoy, you can
5. If you have the AMD package of Davis, Duff and Amestoy, you can
specify `--with-amd` (see `./configure --help` for more details).
We use the C interface to AMD.
5. If you have CUDA available, use
6. If you have CUDA available, use
--enable-cuda to compile CUDA-enabled methods
--with-cudadir=<path> to specify the CUDA toolkit location
--with-cudacc=XX,YY,ZZ to specify a list of target CCs (compute
@ -208,15 +208,16 @@ Salvatore Filippone
**Contributors** (_roughly reverse cronological order_):
- Luca Pepè Sciarria
- Theophane Loloum
- Fabio Durastante
- Dimitri Walther
- Andea Di Iorio
- Stefano Petrilli
- Soren Rasmussen
- Soren Rasmussen
- Zaak Beekman
- Ambra Abdullahi Hassan
- Pasqua D'Ambra
- Ambra Abdullahi Hassan
- Pasqua D'Ambra
- Alfredo Buttari
- Daniela di Serafino
- Michele Martone

@ -631,9 +631,13 @@ endforeach()
list(APPEND PSB_base_source_C_files modules/cutil.c)
list(APPEND PSB_base_source_C_files modules/desc/psb_hashval.c)
if (SERIAL_MPI)
list(APPEND PSB_base_source_C_files modules/fakempi.c)
if (PSB_SERIAL_MPI)
list(APPEND PSB_base_source_C_files modules/psb_fakempi.c)
list(APPEND base_header_C_files ${CMAKE_CURRENT_LIST_DIR}/modules/psb_fakempi.h)
endif()
list(APPEND base_header_C_files ${CMAKE_CURRENT_LIST_DIR}/modules/psb_types.h)
foreach(file IN LISTS PSB_base_source_C_files)
list(APPEND base_source_C_files ${CMAKE_CURRENT_LIST_DIR}/${file})
endforeach()

@ -48,7 +48,8 @@ subroutine psi_covrl_restr_vect(x,xs,desc_a,info)
! locals
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, err_act, i, idx, isz
integer(psb_mpk_) :: np, me, isz
integer(psb_ipk_) :: err_act, i, idx
character(len=20) :: name, ch_err
name='psi_covrl_restr_vect'
@ -91,7 +92,8 @@ subroutine psi_covrl_restr_multivect(x,xs,desc_a,info)
! locals
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, err_act, i, idx, isz, nc
integer(psb_mpk_) :: np, me, isz,nc
integer(psb_ipk_) :: err_act, i, idx
character(len=20) :: name, ch_err
name='psi_covrl_restr_mv'

@ -48,7 +48,8 @@ subroutine psi_covrl_save_vect(x,xs,desc_a,info)
! locals
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, err_act, i, idx, isz
integer(psb_mpk_) :: np, me, isz
integer(psb_ipk_) :: err_act, i, idx
character(len=20) :: name, ch_err
name='psi_dovrl_saver1'
@ -97,7 +98,8 @@ subroutine psi_covrl_save_multivect(x,xs,desc_a,info)
! locals
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, err_act, i, idx, isz, nc
integer(psb_mpk_) :: np, me, isz, nc
integer(psb_ipk_) :: err_act, i, idx
character(len=20) :: name, ch_err
name='psi_dovrl_saver1'

@ -51,7 +51,8 @@ subroutine psi_covrl_upd_vect(x,desc_a,update,info)
! locals
complex(psb_spk_), allocatable :: xs(:)
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, err_act, i, idx, ndm, nx
integer(psb_mpk_) :: np, me, isz, nx, ndm
integer(psb_ipk_) :: err_act, i, idx
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name, ch_err
@ -133,7 +134,8 @@ subroutine psi_covrl_upd_multivect(x,desc_a,update,info)
! locals
complex(psb_spk_), allocatable :: xs(:,:)
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, err_act, i, idx, ndm, nx, nc
integer(psb_mpk_) :: np, me, isz, ndm, nx, nc
integer(psb_ipk_) :: err_act, i, idx
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name, ch_err

@ -203,11 +203,11 @@ subroutine psi_cswap_vidx_vect(ctxt,icomm,flag,beta,y,idx, &
integer(psb_ipk_), intent(in) :: totxch,totsnd, totrcv
! locals
integer(psb_ipk_) :: np, me
integer(psb_mpk_) :: proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret
integer(psb_mpk_) :: np, me
integer(psb_mpk_) :: proc_to_comm, p2ptag, p2pstat(mpi_status_size),&
& iret, nesd, nerv
integer(psb_mpk_), allocatable :: prcid(:)
integer(psb_ipk_) :: nesd, nerv,&
& err_act, i, idx_pt, totsnd_, totrcv_,&
integer(psb_ipk_) :: err_act, i, idx_pt, totsnd_, totrcv_,&
& snd_pt, rcv_pt, pnti, n
logical :: swap_mpi, swap_sync, swap_send, swap_recv,&
& albf,do_send,do_recv
@ -541,12 +541,11 @@ subroutine psi_cswap_vidx_multivect(ctxt,icomm,flag,beta,y,idx, &
integer(psb_ipk_), intent(in) :: totxch,totsnd, totrcv
! locals
integer(psb_ipk_) :: np, me
integer(psb_mpk_) :: np, me, nesd, nerv, n
integer(psb_mpk_) :: proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret
integer(psb_mpk_), allocatable :: prcid(:)
integer(psb_ipk_) :: nesd, nerv,&
& err_act, i, idx_pt, totsnd_, totrcv_,&
& snd_pt, rcv_pt, pnti, n
integer(psb_ipk_) :: err_act, i, idx_pt, totsnd_, totrcv_,&
& snd_pt, rcv_pt, pnti
logical :: swap_mpi, swap_sync, swap_send, swap_recv,&
& albf,do_send,do_recv
logical, parameter :: usersend=.false., debug=.false.

@ -98,7 +98,8 @@ subroutine psi_cswapdatam(flag,n,beta,y,desc_a,work,info,data)
include 'mpif.h'
#endif
integer(psb_ipk_), intent(in) :: flag, n
integer(psb_mpk_), intent(in) :: n
integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info
complex(psb_spk_) :: y(:,:), beta
complex(psb_spk_), target :: work(:)
@ -108,7 +109,8 @@ subroutine psi_cswapdatam(flag,n,beta,y,desc_a,work,info,data)
! locals
type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: icomm
integer(psb_ipk_) :: np, me, idxs, idxr, totxch, data_, err_act
integer(psb_mpk_) :: np, me
integer(psb_ipk_) :: idxs, idxr, totxch, data_, err_act
integer(psb_ipk_), pointer :: d_idx(:)
character(len=20) :: name
@ -171,7 +173,8 @@ subroutine psi_cswapidxm(ctxt,icomm,flag,n,beta,y,idx, &
type(psb_ctxt_type), intent(in) :: ctxt
integer(psb_mpk_), intent(in) :: icomm
integer(psb_ipk_), intent(in) :: flag,n
integer(psb_mpk_), intent(in) :: n
integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info
complex(psb_spk_) :: y(:,:), beta
complex(psb_spk_), target :: work(:)
@ -179,12 +182,11 @@ subroutine psi_cswapidxm(ctxt,icomm,flag,n,beta,y,idx, &
! locals
integer(psb_ipk_) :: np, me
integer(psb_mpk_) :: np, me, nesd, nerv
integer(psb_mpk_) :: proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret
integer(psb_mpk_), allocatable, dimension(:) :: bsdidx, brvidx,&
& sdsz, rvsz, prcid, rvhd, sdhd
integer(psb_ipk_) :: nesd, nerv,&
& err_act, i, idx_pt, totsnd_, totrcv_,&
integer(psb_ipk_) :: err_act, i, idx_pt, totsnd_, totrcv_,&
& snd_pt, rcv_pt, pnti
logical :: swap_mpi, swap_sync, swap_send, swap_recv,&
& albf,do_send,do_recv
@ -585,7 +587,8 @@ subroutine psi_cswapdatav(flag,beta,y,desc_a,work,info,data)
! locals
type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: icomm
integer(psb_ipk_) :: np, me, idxs, idxr, totxch, data_, err_act
integer(psb_mpk_) :: np, me
integer(psb_ipk_) :: idxs, idxr, totxch, data_, err_act
integer(psb_ipk_), pointer :: d_idx(:)
character(len=20) :: name
@ -666,13 +669,12 @@ subroutine psi_cswapidxv(ctxt,icomm,flag,beta,y,idx, &
integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv
! locals
integer(psb_ipk_) :: np, me
integer(psb_mpk_) :: np, me, nesd, nerv, n
integer(psb_mpk_) :: proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret
integer(psb_mpk_), allocatable, dimension(:) :: bsdidx, brvidx,&
& sdsz, rvsz, prcid, rvhd, sdhd
integer(psb_ipk_) :: nesd, nerv,&
& err_act, i, idx_pt, totsnd_, totrcv_,&
& snd_pt, rcv_pt, pnti, n
integer(psb_ipk_) :: err_act, i, idx_pt, totsnd_, totrcv_,&
& snd_pt, rcv_pt, pnti
logical :: swap_mpi, swap_sync, swap_send, swap_recv,&
& albf,do_send,do_recv
logical, parameter :: usersend=.false.

@ -204,12 +204,11 @@ subroutine psi_ctran_vidx_vect(ctxt,icomm,flag,beta,y,idx,&
integer(psb_ipk_), intent(in) :: totxch,totsnd, totrcv
! locals
integer(psb_ipk_) :: np, me
integer(psb_mpk_) :: np, me, nesd, nerv, n
integer(psb_mpk_) :: proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret
integer(psb_mpk_), allocatable :: prcid(:)
integer(psb_ipk_) :: nesd, nerv,&
& err_act, i, idx_pt, totsnd_, totrcv_,&
& snd_pt, rcv_pt, pnti, n
integer(psb_ipk_) :: err_act, i, idx_pt, totsnd_, totrcv_,&
& snd_pt, rcv_pt, pnti
logical :: swap_mpi, swap_sync, swap_send, swap_recv,&
& albf,do_send,do_recv
logical, parameter :: usersend=.false., debug=.false.
@ -552,12 +551,11 @@ subroutine psi_ctran_vidx_multivect(ctxt,icomm,flag,beta,y,idx,&
integer(psb_ipk_), intent(in) :: totxch,totsnd, totrcv
! locals
integer(psb_ipk_) :: np, me
integer(psb_mpk_) :: np, me, nesd, nerv, n
integer(psb_mpk_) :: proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret
integer(psb_mpk_), allocatable :: prcid(:)
integer(psb_ipk_) :: nesd, nerv,&
& err_act, i, idx_pt, totsnd_, totrcv_,&
& snd_pt, rcv_pt, pnti, n
integer(psb_ipk_) :: err_act, i, idx_pt, totsnd_, totrcv_,&
& snd_pt, rcv_pt, pnti
logical :: swap_mpi, swap_sync, swap_send, swap_recv,&
& albf,do_send,do_recv
logical, parameter :: usersend=.false., debug=.false.

@ -102,7 +102,8 @@ subroutine psi_cswaptranm(flag,n,beta,y,desc_a,work,info,data)
include 'mpif.h'
#endif
integer(psb_ipk_), intent(in) :: flag, n
integer(psb_mpk_), intent(in) :: n
integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info
complex(psb_spk_) :: y(:,:), beta
complex(psb_spk_), target :: work(:)
@ -112,7 +113,8 @@ subroutine psi_cswaptranm(flag,n,beta,y,desc_a,work,info,data)
! locals
type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: icomm
integer(psb_ipk_) :: np, me, idxs, idxr, err_act, totxch, data_
integer(psb_mpk_) :: np, me
integer(psb_ipk_) :: idxs, idxr, err_act, totxch, data_
integer(psb_ipk_), pointer :: d_idx(:)
character(len=20) :: name
@ -176,19 +178,19 @@ subroutine psi_ctranidxm(ctxt,icomm,flag,n,beta,y,idx,&
type(psb_ctxt_type), intent(in) :: ctxt
integer(psb_mpk_), intent(in) :: icomm
integer(psb_ipk_), intent(in) :: flag,n
integer(psb_mpk_), intent(in) :: n
integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info
complex(psb_spk_) :: y(:,:), beta
complex(psb_spk_), target :: work(:)
integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv
! locals
integer(psb_ipk_) :: np, me
integer(psb_mpk_) :: np, me, nesd, nerv
integer(psb_mpk_) :: proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret
integer(psb_mpk_), allocatable, dimension(:) :: bsdidx, brvidx,&
& sdsz, rvsz, prcid, rvhd, sdhd
integer(psb_ipk_) :: nesd, nerv,&
& err_act, i, idx_pt, totsnd_, totrcv_,&
integer(psb_ipk_) :: err_act, i, idx_pt, totsnd_, totrcv_,&
& snd_pt, rcv_pt, pnti
logical :: swap_mpi, swap_sync, swap_send, swap_recv,&
& albf,do_send,do_recv
@ -678,13 +680,12 @@ subroutine psi_ctranidxv(ctxt,icomm,flag,beta,y,idx,&
integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv
! locals
integer(psb_ipk_) :: np, me
integer(psb_mpk_) :: np, me, nesd, nerv, n
integer(psb_mpk_) :: proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret
integer(psb_mpk_), allocatable, dimension(:) :: bsdidx, brvidx,&
& sdsz, rvsz, prcid, rvhd, sdhd
integer(psb_ipk_) :: nesd, nerv,&
& err_act, i, idx_pt, totsnd_, totrcv_,&
& snd_pt, rcv_pt, pnti, n
integer(psb_ipk_) :: err_act, i, idx_pt, totsnd_, totrcv_,&
& snd_pt, rcv_pt, pnti
logical :: swap_mpi, swap_sync, swap_send, swap_recv,&
& albf,do_send,do_recv
logical, parameter :: usersend=.false.

@ -48,7 +48,8 @@ subroutine psi_dovrl_restr_vect(x,xs,desc_a,info)
! locals
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, err_act, i, idx, isz
integer(psb_mpk_) :: np, me, isz
integer(psb_ipk_) :: err_act, i, idx
character(len=20) :: name, ch_err
name='psi_dovrl_restr_vect'
@ -91,7 +92,8 @@ subroutine psi_dovrl_restr_multivect(x,xs,desc_a,info)
! locals
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, err_act, i, idx, isz, nc
integer(psb_mpk_) :: np, me, isz,nc
integer(psb_ipk_) :: err_act, i, idx
character(len=20) :: name, ch_err
name='psi_dovrl_restr_mv'

@ -48,7 +48,8 @@ subroutine psi_dovrl_save_vect(x,xs,desc_a,info)
! locals
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, err_act, i, idx, isz
integer(psb_mpk_) :: np, me, isz
integer(psb_ipk_) :: err_act, i, idx
character(len=20) :: name, ch_err
name='psi_dovrl_saver1'
@ -97,7 +98,8 @@ subroutine psi_dovrl_save_multivect(x,xs,desc_a,info)
! locals
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, err_act, i, idx, isz, nc
integer(psb_mpk_) :: np, me, isz, nc
integer(psb_ipk_) :: err_act, i, idx
character(len=20) :: name, ch_err
name='psi_dovrl_saver1'

@ -51,7 +51,8 @@ subroutine psi_dovrl_upd_vect(x,desc_a,update,info)
! locals
real(psb_dpk_), allocatable :: xs(:)
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, err_act, i, idx, ndm, nx
integer(psb_mpk_) :: np, me, isz, nx, ndm
integer(psb_ipk_) :: err_act, i, idx
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name, ch_err
@ -133,7 +134,8 @@ subroutine psi_dovrl_upd_multivect(x,desc_a,update,info)
! locals
real(psb_dpk_), allocatable :: xs(:,:)
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, err_act, i, idx, ndm, nx, nc
integer(psb_mpk_) :: np, me, isz, ndm, nx, nc
integer(psb_ipk_) :: err_act, i, idx
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name, ch_err

@ -203,11 +203,11 @@ subroutine psi_dswap_vidx_vect(ctxt,icomm,flag,beta,y,idx, &
integer(psb_ipk_), intent(in) :: totxch,totsnd, totrcv
! locals
integer(psb_ipk_) :: np, me
integer(psb_mpk_) :: proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret
integer(psb_mpk_) :: np, me
integer(psb_mpk_) :: proc_to_comm, p2ptag, p2pstat(mpi_status_size),&
& iret, nesd, nerv
integer(psb_mpk_), allocatable :: prcid(:)
integer(psb_ipk_) :: nesd, nerv,&
& err_act, i, idx_pt, totsnd_, totrcv_,&
integer(psb_ipk_) :: err_act, i, idx_pt, totsnd_, totrcv_,&
& snd_pt, rcv_pt, pnti, n
logical :: swap_mpi, swap_sync, swap_send, swap_recv,&
& albf,do_send,do_recv
@ -541,12 +541,11 @@ subroutine psi_dswap_vidx_multivect(ctxt,icomm,flag,beta,y,idx, &
integer(psb_ipk_), intent(in) :: totxch,totsnd, totrcv
! locals
integer(psb_ipk_) :: np, me
integer(psb_mpk_) :: np, me, nesd, nerv, n
integer(psb_mpk_) :: proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret
integer(psb_mpk_), allocatable :: prcid(:)
integer(psb_ipk_) :: nesd, nerv,&
& err_act, i, idx_pt, totsnd_, totrcv_,&
& snd_pt, rcv_pt, pnti, n
integer(psb_ipk_) :: err_act, i, idx_pt, totsnd_, totrcv_,&
& snd_pt, rcv_pt, pnti
logical :: swap_mpi, swap_sync, swap_send, swap_recv,&
& albf,do_send,do_recv
logical, parameter :: usersend=.false., debug=.false.

@ -98,7 +98,8 @@ subroutine psi_dswapdatam(flag,n,beta,y,desc_a,work,info,data)
include 'mpif.h'
#endif
integer(psb_ipk_), intent(in) :: flag, n
integer(psb_mpk_), intent(in) :: n
integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info
real(psb_dpk_) :: y(:,:), beta
real(psb_dpk_), target :: work(:)
@ -108,7 +109,8 @@ subroutine psi_dswapdatam(flag,n,beta,y,desc_a,work,info,data)
! locals
type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: icomm
integer(psb_ipk_) :: np, me, idxs, idxr, totxch, data_, err_act
integer(psb_mpk_) :: np, me
integer(psb_ipk_) :: idxs, idxr, totxch, data_, err_act
integer(psb_ipk_), pointer :: d_idx(:)
character(len=20) :: name
@ -171,7 +173,8 @@ subroutine psi_dswapidxm(ctxt,icomm,flag,n,beta,y,idx, &
type(psb_ctxt_type), intent(in) :: ctxt
integer(psb_mpk_), intent(in) :: icomm
integer(psb_ipk_), intent(in) :: flag,n
integer(psb_mpk_), intent(in) :: n
integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info
real(psb_dpk_) :: y(:,:), beta
real(psb_dpk_), target :: work(:)
@ -179,12 +182,11 @@ subroutine psi_dswapidxm(ctxt,icomm,flag,n,beta,y,idx, &
! locals
integer(psb_ipk_) :: np, me
integer(psb_mpk_) :: np, me, nesd, nerv
integer(psb_mpk_) :: proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret
integer(psb_mpk_), allocatable, dimension(:) :: bsdidx, brvidx,&
& sdsz, rvsz, prcid, rvhd, sdhd
integer(psb_ipk_) :: nesd, nerv,&
& err_act, i, idx_pt, totsnd_, totrcv_,&
integer(psb_ipk_) :: err_act, i, idx_pt, totsnd_, totrcv_,&
& snd_pt, rcv_pt, pnti
logical :: swap_mpi, swap_sync, swap_send, swap_recv,&
& albf,do_send,do_recv
@ -585,7 +587,8 @@ subroutine psi_dswapdatav(flag,beta,y,desc_a,work,info,data)
! locals
type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: icomm
integer(psb_ipk_) :: np, me, idxs, idxr, totxch, data_, err_act
integer(psb_mpk_) :: np, me
integer(psb_ipk_) :: idxs, idxr, totxch, data_, err_act
integer(psb_ipk_), pointer :: d_idx(:)
character(len=20) :: name
@ -666,13 +669,12 @@ subroutine psi_dswapidxv(ctxt,icomm,flag,beta,y,idx, &
integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv
! locals
integer(psb_ipk_) :: np, me
integer(psb_mpk_) :: np, me, nesd, nerv, n
integer(psb_mpk_) :: proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret
integer(psb_mpk_), allocatable, dimension(:) :: bsdidx, brvidx,&
& sdsz, rvsz, prcid, rvhd, sdhd
integer(psb_ipk_) :: nesd, nerv,&
& err_act, i, idx_pt, totsnd_, totrcv_,&
& snd_pt, rcv_pt, pnti, n
integer(psb_ipk_) :: err_act, i, idx_pt, totsnd_, totrcv_,&
& snd_pt, rcv_pt, pnti
logical :: swap_mpi, swap_sync, swap_send, swap_recv,&
& albf,do_send,do_recv
logical, parameter :: usersend=.false.

@ -204,12 +204,11 @@ subroutine psi_dtran_vidx_vect(ctxt,icomm,flag,beta,y,idx,&
integer(psb_ipk_), intent(in) :: totxch,totsnd, totrcv
! locals
integer(psb_ipk_) :: np, me
integer(psb_mpk_) :: np, me, nesd, nerv, n
integer(psb_mpk_) :: proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret
integer(psb_mpk_), allocatable :: prcid(:)
integer(psb_ipk_) :: nesd, nerv,&
& err_act, i, idx_pt, totsnd_, totrcv_,&
& snd_pt, rcv_pt, pnti, n
integer(psb_ipk_) :: err_act, i, idx_pt, totsnd_, totrcv_,&
& snd_pt, rcv_pt, pnti
logical :: swap_mpi, swap_sync, swap_send, swap_recv,&
& albf,do_send,do_recv
logical, parameter :: usersend=.false., debug=.false.
@ -552,12 +551,11 @@ subroutine psi_dtran_vidx_multivect(ctxt,icomm,flag,beta,y,idx,&
integer(psb_ipk_), intent(in) :: totxch,totsnd, totrcv
! locals
integer(psb_ipk_) :: np, me
integer(psb_mpk_) :: np, me, nesd, nerv, n
integer(psb_mpk_) :: proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret
integer(psb_mpk_), allocatable :: prcid(:)
integer(psb_ipk_) :: nesd, nerv,&
& err_act, i, idx_pt, totsnd_, totrcv_,&
& snd_pt, rcv_pt, pnti, n
integer(psb_ipk_) :: err_act, i, idx_pt, totsnd_, totrcv_,&
& snd_pt, rcv_pt, pnti
logical :: swap_mpi, swap_sync, swap_send, swap_recv,&
& albf,do_send,do_recv
logical, parameter :: usersend=.false., debug=.false.

@ -102,7 +102,8 @@ subroutine psi_dswaptranm(flag,n,beta,y,desc_a,work,info,data)
include 'mpif.h'
#endif
integer(psb_ipk_), intent(in) :: flag, n
integer(psb_mpk_), intent(in) :: n
integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info
real(psb_dpk_) :: y(:,:), beta
real(psb_dpk_), target :: work(:)
@ -112,7 +113,8 @@ subroutine psi_dswaptranm(flag,n,beta,y,desc_a,work,info,data)
! locals
type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: icomm
integer(psb_ipk_) :: np, me, idxs, idxr, err_act, totxch, data_
integer(psb_mpk_) :: np, me
integer(psb_ipk_) :: idxs, idxr, err_act, totxch, data_
integer(psb_ipk_), pointer :: d_idx(:)
character(len=20) :: name
@ -176,19 +178,19 @@ subroutine psi_dtranidxm(ctxt,icomm,flag,n,beta,y,idx,&
type(psb_ctxt_type), intent(in) :: ctxt
integer(psb_mpk_), intent(in) :: icomm
integer(psb_ipk_), intent(in) :: flag,n
integer(psb_mpk_), intent(in) :: n
integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info
real(psb_dpk_) :: y(:,:), beta
real(psb_dpk_), target :: work(:)
integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv
! locals
integer(psb_ipk_) :: np, me
integer(psb_mpk_) :: np, me, nesd, nerv
integer(psb_mpk_) :: proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret
integer(psb_mpk_), allocatable, dimension(:) :: bsdidx, brvidx,&
& sdsz, rvsz, prcid, rvhd, sdhd
integer(psb_ipk_) :: nesd, nerv,&
& err_act, i, idx_pt, totsnd_, totrcv_,&
integer(psb_ipk_) :: err_act, i, idx_pt, totsnd_, totrcv_,&
& snd_pt, rcv_pt, pnti
logical :: swap_mpi, swap_sync, swap_send, swap_recv,&
& albf,do_send,do_recv
@ -678,13 +680,12 @@ subroutine psi_dtranidxv(ctxt,icomm,flag,beta,y,idx,&
integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv
! locals
integer(psb_ipk_) :: np, me
integer(psb_mpk_) :: np, me, nesd, nerv, n
integer(psb_mpk_) :: proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret
integer(psb_mpk_), allocatable, dimension(:) :: bsdidx, brvidx,&
& sdsz, rvsz, prcid, rvhd, sdhd
integer(psb_ipk_) :: nesd, nerv,&
& err_act, i, idx_pt, totsnd_, totrcv_,&
& snd_pt, rcv_pt, pnti, n
integer(psb_ipk_) :: err_act, i, idx_pt, totsnd_, totrcv_,&
& snd_pt, rcv_pt, pnti
logical :: swap_mpi, swap_sync, swap_send, swap_recv,&
& albf,do_send,do_recv
logical, parameter :: usersend=.false.

@ -98,7 +98,8 @@ subroutine psi_eswapdatam(flag,n,beta,y,desc_a,work,info,data)
include 'mpif.h'
#endif
integer(psb_ipk_), intent(in) :: flag, n
integer(psb_mpk_), intent(in) :: n
integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info
integer(psb_epk_) :: y(:,:), beta
integer(psb_epk_), target :: work(:)
@ -108,7 +109,8 @@ subroutine psi_eswapdatam(flag,n,beta,y,desc_a,work,info,data)
! locals
type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: icomm
integer(psb_ipk_) :: np, me, idxs, idxr, totxch, data_, err_act
integer(psb_mpk_) :: np, me
integer(psb_ipk_) :: idxs, idxr, totxch, data_, err_act
integer(psb_ipk_), pointer :: d_idx(:)
character(len=20) :: name
@ -171,7 +173,8 @@ subroutine psi_eswapidxm(ctxt,icomm,flag,n,beta,y,idx, &
type(psb_ctxt_type), intent(in) :: ctxt
integer(psb_mpk_), intent(in) :: icomm
integer(psb_ipk_), intent(in) :: flag,n
integer(psb_mpk_), intent(in) :: n
integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info
integer(psb_epk_) :: y(:,:), beta
integer(psb_epk_), target :: work(:)
@ -179,12 +182,11 @@ subroutine psi_eswapidxm(ctxt,icomm,flag,n,beta,y,idx, &
! locals
integer(psb_ipk_) :: np, me
integer(psb_mpk_) :: np, me, nesd, nerv
integer(psb_mpk_) :: proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret
integer(psb_mpk_), allocatable, dimension(:) :: bsdidx, brvidx,&
& sdsz, rvsz, prcid, rvhd, sdhd
integer(psb_ipk_) :: nesd, nerv,&
& err_act, i, idx_pt, totsnd_, totrcv_,&
integer(psb_ipk_) :: err_act, i, idx_pt, totsnd_, totrcv_,&
& snd_pt, rcv_pt, pnti
logical :: swap_mpi, swap_sync, swap_send, swap_recv,&
& albf,do_send,do_recv
@ -585,7 +587,8 @@ subroutine psi_eswapdatav(flag,beta,y,desc_a,work,info,data)
! locals
type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: icomm
integer(psb_ipk_) :: np, me, idxs, idxr, totxch, data_, err_act
integer(psb_mpk_) :: np, me
integer(psb_ipk_) :: idxs, idxr, totxch, data_, err_act
integer(psb_ipk_), pointer :: d_idx(:)
character(len=20) :: name
@ -666,13 +669,12 @@ subroutine psi_eswapidxv(ctxt,icomm,flag,beta,y,idx, &
integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv
! locals
integer(psb_ipk_) :: np, me
integer(psb_mpk_) :: np, me, nesd, nerv, n
integer(psb_mpk_) :: proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret
integer(psb_mpk_), allocatable, dimension(:) :: bsdidx, brvidx,&
& sdsz, rvsz, prcid, rvhd, sdhd
integer(psb_ipk_) :: nesd, nerv,&
& err_act, i, idx_pt, totsnd_, totrcv_,&
& snd_pt, rcv_pt, pnti, n
integer(psb_ipk_) :: err_act, i, idx_pt, totsnd_, totrcv_,&
& snd_pt, rcv_pt, pnti
logical :: swap_mpi, swap_sync, swap_send, swap_recv,&
& albf,do_send,do_recv
logical, parameter :: usersend=.false.

@ -102,7 +102,8 @@ subroutine psi_eswaptranm(flag,n,beta,y,desc_a,work,info,data)
include 'mpif.h'
#endif
integer(psb_ipk_), intent(in) :: flag, n
integer(psb_mpk_), intent(in) :: n
integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info
integer(psb_epk_) :: y(:,:), beta
integer(psb_epk_), target :: work(:)
@ -112,7 +113,8 @@ subroutine psi_eswaptranm(flag,n,beta,y,desc_a,work,info,data)
! locals
type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: icomm
integer(psb_ipk_) :: np, me, idxs, idxr, err_act, totxch, data_
integer(psb_mpk_) :: np, me
integer(psb_ipk_) :: idxs, idxr, err_act, totxch, data_
integer(psb_ipk_), pointer :: d_idx(:)
character(len=20) :: name
@ -176,19 +178,19 @@ subroutine psi_etranidxm(ctxt,icomm,flag,n,beta,y,idx,&
type(psb_ctxt_type), intent(in) :: ctxt
integer(psb_mpk_), intent(in) :: icomm
integer(psb_ipk_), intent(in) :: flag,n
integer(psb_mpk_), intent(in) :: n
integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info
integer(psb_epk_) :: y(:,:), beta
integer(psb_epk_), target :: work(:)
integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv
! locals
integer(psb_ipk_) :: np, me
integer(psb_mpk_) :: np, me, nesd, nerv
integer(psb_mpk_) :: proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret
integer(psb_mpk_), allocatable, dimension(:) :: bsdidx, brvidx,&
& sdsz, rvsz, prcid, rvhd, sdhd
integer(psb_ipk_) :: nesd, nerv,&
& err_act, i, idx_pt, totsnd_, totrcv_,&
integer(psb_ipk_) :: err_act, i, idx_pt, totsnd_, totrcv_,&
& snd_pt, rcv_pt, pnti
logical :: swap_mpi, swap_sync, swap_send, swap_recv,&
& albf,do_send,do_recv
@ -678,13 +680,12 @@ subroutine psi_etranidxv(ctxt,icomm,flag,beta,y,idx,&
integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv
! locals
integer(psb_ipk_) :: np, me
integer(psb_mpk_) :: np, me, nesd, nerv, n
integer(psb_mpk_) :: proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret
integer(psb_mpk_), allocatable, dimension(:) :: bsdidx, brvidx,&
& sdsz, rvsz, prcid, rvhd, sdhd
integer(psb_ipk_) :: nesd, nerv,&
& err_act, i, idx_pt, totsnd_, totrcv_,&
& snd_pt, rcv_pt, pnti, n
integer(psb_ipk_) :: err_act, i, idx_pt, totsnd_, totrcv_,&
& snd_pt, rcv_pt, pnti
logical :: swap_mpi, swap_sync, swap_send, swap_recv,&
& albf,do_send,do_recv
logical, parameter :: usersend=.false.

@ -98,7 +98,8 @@ subroutine psi_i2swapdatam(flag,n,beta,y,desc_a,work,info,data)
include 'mpif.h'
#endif
integer(psb_ipk_), intent(in) :: flag, n
integer(psb_mpk_), intent(in) :: n
integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info
integer(psb_i2pk_) :: y(:,:), beta
integer(psb_i2pk_), target :: work(:)
@ -108,7 +109,8 @@ subroutine psi_i2swapdatam(flag,n,beta,y,desc_a,work,info,data)
! locals
type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: icomm
integer(psb_ipk_) :: np, me, idxs, idxr, totxch, data_, err_act
integer(psb_mpk_) :: np, me
integer(psb_ipk_) :: idxs, idxr, totxch, data_, err_act
integer(psb_ipk_), pointer :: d_idx(:)
character(len=20) :: name
@ -171,7 +173,8 @@ subroutine psi_i2swapidxm(ctxt,icomm,flag,n,beta,y,idx, &
type(psb_ctxt_type), intent(in) :: ctxt
integer(psb_mpk_), intent(in) :: icomm
integer(psb_ipk_), intent(in) :: flag,n
integer(psb_mpk_), intent(in) :: n
integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info
integer(psb_i2pk_) :: y(:,:), beta
integer(psb_i2pk_), target :: work(:)
@ -179,12 +182,11 @@ subroutine psi_i2swapidxm(ctxt,icomm,flag,n,beta,y,idx, &
! locals
integer(psb_ipk_) :: np, me
integer(psb_mpk_) :: np, me, nesd, nerv
integer(psb_mpk_) :: proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret
integer(psb_mpk_), allocatable, dimension(:) :: bsdidx, brvidx,&
& sdsz, rvsz, prcid, rvhd, sdhd
integer(psb_ipk_) :: nesd, nerv,&
& err_act, i, idx_pt, totsnd_, totrcv_,&
integer(psb_ipk_) :: err_act, i, idx_pt, totsnd_, totrcv_,&
& snd_pt, rcv_pt, pnti
logical :: swap_mpi, swap_sync, swap_send, swap_recv,&
& albf,do_send,do_recv
@ -585,7 +587,8 @@ subroutine psi_i2swapdatav(flag,beta,y,desc_a,work,info,data)
! locals
type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: icomm
integer(psb_ipk_) :: np, me, idxs, idxr, totxch, data_, err_act
integer(psb_mpk_) :: np, me
integer(psb_ipk_) :: idxs, idxr, totxch, data_, err_act
integer(psb_ipk_), pointer :: d_idx(:)
character(len=20) :: name
@ -666,13 +669,12 @@ subroutine psi_i2swapidxv(ctxt,icomm,flag,beta,y,idx, &
integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv
! locals
integer(psb_ipk_) :: np, me
integer(psb_mpk_) :: np, me, nesd, nerv, n
integer(psb_mpk_) :: proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret
integer(psb_mpk_), allocatable, dimension(:) :: bsdidx, brvidx,&
& sdsz, rvsz, prcid, rvhd, sdhd
integer(psb_ipk_) :: nesd, nerv,&
& err_act, i, idx_pt, totsnd_, totrcv_,&
& snd_pt, rcv_pt, pnti, n
integer(psb_ipk_) :: err_act, i, idx_pt, totsnd_, totrcv_,&
& snd_pt, rcv_pt, pnti
logical :: swap_mpi, swap_sync, swap_send, swap_recv,&
& albf,do_send,do_recv
logical, parameter :: usersend=.false.

@ -102,7 +102,8 @@ subroutine psi_i2swaptranm(flag,n,beta,y,desc_a,work,info,data)
include 'mpif.h'
#endif
integer(psb_ipk_), intent(in) :: flag, n
integer(psb_mpk_), intent(in) :: n
integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info
integer(psb_i2pk_) :: y(:,:), beta
integer(psb_i2pk_), target :: work(:)
@ -112,7 +113,8 @@ subroutine psi_i2swaptranm(flag,n,beta,y,desc_a,work,info,data)
! locals
type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: icomm
integer(psb_ipk_) :: np, me, idxs, idxr, err_act, totxch, data_
integer(psb_mpk_) :: np, me
integer(psb_ipk_) :: idxs, idxr, err_act, totxch, data_
integer(psb_ipk_), pointer :: d_idx(:)
character(len=20) :: name
@ -176,19 +178,19 @@ subroutine psi_i2tranidxm(ctxt,icomm,flag,n,beta,y,idx,&
type(psb_ctxt_type), intent(in) :: ctxt
integer(psb_mpk_), intent(in) :: icomm
integer(psb_ipk_), intent(in) :: flag,n
integer(psb_mpk_), intent(in) :: n
integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info
integer(psb_i2pk_) :: y(:,:), beta
integer(psb_i2pk_), target :: work(:)
integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv
! locals
integer(psb_ipk_) :: np, me
integer(psb_mpk_) :: np, me, nesd, nerv
integer(psb_mpk_) :: proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret
integer(psb_mpk_), allocatable, dimension(:) :: bsdidx, brvidx,&
& sdsz, rvsz, prcid, rvhd, sdhd
integer(psb_ipk_) :: nesd, nerv,&
& err_act, i, idx_pt, totsnd_, totrcv_,&
integer(psb_ipk_) :: err_act, i, idx_pt, totsnd_, totrcv_,&
& snd_pt, rcv_pt, pnti
logical :: swap_mpi, swap_sync, swap_send, swap_recv,&
& albf,do_send,do_recv
@ -678,13 +680,12 @@ subroutine psi_i2tranidxv(ctxt,icomm,flag,beta,y,idx,&
integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv
! locals
integer(psb_ipk_) :: np, me
integer(psb_mpk_) :: np, me, nesd, nerv, n
integer(psb_mpk_) :: proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret
integer(psb_mpk_), allocatable, dimension(:) :: bsdidx, brvidx,&
& sdsz, rvsz, prcid, rvhd, sdhd
integer(psb_ipk_) :: nesd, nerv,&
& err_act, i, idx_pt, totsnd_, totrcv_,&
& snd_pt, rcv_pt, pnti, n
integer(psb_ipk_) :: err_act, i, idx_pt, totsnd_, totrcv_,&
& snd_pt, rcv_pt, pnti
logical :: swap_mpi, swap_sync, swap_send, swap_recv,&
& albf,do_send,do_recv
logical, parameter :: usersend=.false.

@ -48,7 +48,8 @@ subroutine psi_iovrl_restr_vect(x,xs,desc_a,info)
! locals
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, err_act, i, idx, isz
integer(psb_mpk_) :: np, me, isz
integer(psb_ipk_) :: err_act, i, idx
character(len=20) :: name, ch_err
name='psi_iovrl_restr_vect'
@ -91,7 +92,8 @@ subroutine psi_iovrl_restr_multivect(x,xs,desc_a,info)
! locals
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, err_act, i, idx, isz, nc
integer(psb_mpk_) :: np, me, isz,nc
integer(psb_ipk_) :: err_act, i, idx
character(len=20) :: name, ch_err
name='psi_iovrl_restr_mv'

@ -48,7 +48,8 @@ subroutine psi_iovrl_save_vect(x,xs,desc_a,info)
! locals
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, err_act, i, idx, isz
integer(psb_mpk_) :: np, me, isz
integer(psb_ipk_) :: err_act, i, idx
character(len=20) :: name, ch_err
name='psi_dovrl_saver1'
@ -97,7 +98,8 @@ subroutine psi_iovrl_save_multivect(x,xs,desc_a,info)
! locals
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, err_act, i, idx, isz, nc
integer(psb_mpk_) :: np, me, isz, nc
integer(psb_ipk_) :: err_act, i, idx
character(len=20) :: name, ch_err
name='psi_dovrl_saver1'

@ -51,7 +51,8 @@ subroutine psi_iovrl_upd_vect(x,desc_a,update,info)
! locals
integer(psb_ipk_), allocatable :: xs(:)
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, err_act, i, idx, ndm, nx
integer(psb_mpk_) :: np, me, isz, nx, ndm
integer(psb_ipk_) :: err_act, i, idx
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name, ch_err
@ -133,7 +134,8 @@ subroutine psi_iovrl_upd_multivect(x,desc_a,update,info)
! locals
integer(psb_ipk_), allocatable :: xs(:,:)
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, err_act, i, idx, ndm, nx, nc
integer(psb_mpk_) :: np, me, isz, ndm, nx, nc
integer(psb_ipk_) :: err_act, i, idx
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name, ch_err

@ -203,11 +203,11 @@ subroutine psi_iswap_vidx_vect(ctxt,icomm,flag,beta,y,idx, &
integer(psb_ipk_), intent(in) :: totxch,totsnd, totrcv
! locals
integer(psb_ipk_) :: np, me
integer(psb_mpk_) :: proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret
integer(psb_mpk_) :: np, me
integer(psb_mpk_) :: proc_to_comm, p2ptag, p2pstat(mpi_status_size),&
& iret, nesd, nerv
integer(psb_mpk_), allocatable :: prcid(:)
integer(psb_ipk_) :: nesd, nerv,&
& err_act, i, idx_pt, totsnd_, totrcv_,&
integer(psb_ipk_) :: err_act, i, idx_pt, totsnd_, totrcv_,&
& snd_pt, rcv_pt, pnti, n
logical :: swap_mpi, swap_sync, swap_send, swap_recv,&
& albf,do_send,do_recv
@ -541,12 +541,11 @@ subroutine psi_iswap_vidx_multivect(ctxt,icomm,flag,beta,y,idx, &
integer(psb_ipk_), intent(in) :: totxch,totsnd, totrcv
! locals
integer(psb_ipk_) :: np, me
integer(psb_mpk_) :: np, me, nesd, nerv, n
integer(psb_mpk_) :: proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret
integer(psb_mpk_), allocatable :: prcid(:)
integer(psb_ipk_) :: nesd, nerv,&
& err_act, i, idx_pt, totsnd_, totrcv_,&
& snd_pt, rcv_pt, pnti, n
integer(psb_ipk_) :: err_act, i, idx_pt, totsnd_, totrcv_,&
& snd_pt, rcv_pt, pnti
logical :: swap_mpi, swap_sync, swap_send, swap_recv,&
& albf,do_send,do_recv
logical, parameter :: usersend=.false., debug=.false.

@ -204,12 +204,11 @@ subroutine psi_itran_vidx_vect(ctxt,icomm,flag,beta,y,idx,&
integer(psb_ipk_), intent(in) :: totxch,totsnd, totrcv
! locals
integer(psb_ipk_) :: np, me
integer(psb_mpk_) :: np, me, nesd, nerv, n
integer(psb_mpk_) :: proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret
integer(psb_mpk_), allocatable :: prcid(:)
integer(psb_ipk_) :: nesd, nerv,&
& err_act, i, idx_pt, totsnd_, totrcv_,&
& snd_pt, rcv_pt, pnti, n
integer(psb_ipk_) :: err_act, i, idx_pt, totsnd_, totrcv_,&
& snd_pt, rcv_pt, pnti
logical :: swap_mpi, swap_sync, swap_send, swap_recv,&
& albf,do_send,do_recv
logical, parameter :: usersend=.false., debug=.false.
@ -552,12 +551,11 @@ subroutine psi_itran_vidx_multivect(ctxt,icomm,flag,beta,y,idx,&
integer(psb_ipk_), intent(in) :: totxch,totsnd, totrcv
! locals
integer(psb_ipk_) :: np, me
integer(psb_mpk_) :: np, me, nesd, nerv, n
integer(psb_mpk_) :: proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret
integer(psb_mpk_), allocatable :: prcid(:)
integer(psb_ipk_) :: nesd, nerv,&
& err_act, i, idx_pt, totsnd_, totrcv_,&
& snd_pt, rcv_pt, pnti, n
integer(psb_ipk_) :: err_act, i, idx_pt, totsnd_, totrcv_,&
& snd_pt, rcv_pt, pnti
logical :: swap_mpi, swap_sync, swap_send, swap_recv,&
& albf,do_send,do_recv
logical, parameter :: usersend=.false., debug=.false.

@ -48,7 +48,8 @@ subroutine psi_lovrl_restr_vect(x,xs,desc_a,info)
! locals
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, err_act, i, idx, isz
integer(psb_mpk_) :: np, me, isz
integer(psb_ipk_) :: err_act, i, idx
character(len=20) :: name, ch_err
name='psi_lovrl_restr_vect'
@ -91,7 +92,8 @@ subroutine psi_lovrl_restr_multivect(x,xs,desc_a,info)
! locals
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, err_act, i, idx, isz, nc
integer(psb_mpk_) :: np, me, isz,nc
integer(psb_ipk_) :: err_act, i, idx
character(len=20) :: name, ch_err
name='psi_lovrl_restr_mv'

@ -48,7 +48,8 @@ subroutine psi_lovrl_save_vect(x,xs,desc_a,info)
! locals
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, err_act, i, idx, isz
integer(psb_mpk_) :: np, me, isz
integer(psb_ipk_) :: err_act, i, idx
character(len=20) :: name, ch_err
name='psi_dovrl_saver1'
@ -97,7 +98,8 @@ subroutine psi_lovrl_save_multivect(x,xs,desc_a,info)
! locals
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, err_act, i, idx, isz, nc
integer(psb_mpk_) :: np, me, isz, nc
integer(psb_ipk_) :: err_act, i, idx
character(len=20) :: name, ch_err
name='psi_dovrl_saver1'

@ -51,7 +51,8 @@ subroutine psi_lovrl_upd_vect(x,desc_a,update,info)
! locals
integer(psb_lpk_), allocatable :: xs(:)
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, err_act, i, idx, ndm, nx
integer(psb_mpk_) :: np, me, isz, nx, ndm
integer(psb_ipk_) :: err_act, i, idx
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name, ch_err
@ -133,7 +134,8 @@ subroutine psi_lovrl_upd_multivect(x,desc_a,update,info)
! locals
integer(psb_lpk_), allocatable :: xs(:,:)
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, err_act, i, idx, ndm, nx, nc
integer(psb_mpk_) :: np, me, isz, ndm, nx, nc
integer(psb_ipk_) :: err_act, i, idx
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name, ch_err

@ -203,11 +203,11 @@ subroutine psi_lswap_vidx_vect(ctxt,icomm,flag,beta,y,idx, &
integer(psb_ipk_), intent(in) :: totxch,totsnd, totrcv
! locals
integer(psb_ipk_) :: np, me
integer(psb_mpk_) :: proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret
integer(psb_mpk_) :: np, me
integer(psb_mpk_) :: proc_to_comm, p2ptag, p2pstat(mpi_status_size),&
& iret, nesd, nerv
integer(psb_mpk_), allocatable :: prcid(:)
integer(psb_ipk_) :: nesd, nerv,&
& err_act, i, idx_pt, totsnd_, totrcv_,&
integer(psb_ipk_) :: err_act, i, idx_pt, totsnd_, totrcv_,&
& snd_pt, rcv_pt, pnti, n
logical :: swap_mpi, swap_sync, swap_send, swap_recv,&
& albf,do_send,do_recv
@ -541,12 +541,11 @@ subroutine psi_lswap_vidx_multivect(ctxt,icomm,flag,beta,y,idx, &
integer(psb_ipk_), intent(in) :: totxch,totsnd, totrcv
! locals
integer(psb_ipk_) :: np, me
integer(psb_mpk_) :: np, me, nesd, nerv, n
integer(psb_mpk_) :: proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret
integer(psb_mpk_), allocatable :: prcid(:)
integer(psb_ipk_) :: nesd, nerv,&
& err_act, i, idx_pt, totsnd_, totrcv_,&
& snd_pt, rcv_pt, pnti, n
integer(psb_ipk_) :: err_act, i, idx_pt, totsnd_, totrcv_,&
& snd_pt, rcv_pt, pnti
logical :: swap_mpi, swap_sync, swap_send, swap_recv,&
& albf,do_send,do_recv
logical, parameter :: usersend=.false., debug=.false.

@ -204,12 +204,11 @@ subroutine psi_ltran_vidx_vect(ctxt,icomm,flag,beta,y,idx,&
integer(psb_ipk_), intent(in) :: totxch,totsnd, totrcv
! locals
integer(psb_ipk_) :: np, me
integer(psb_mpk_) :: np, me, nesd, nerv, n
integer(psb_mpk_) :: proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret
integer(psb_mpk_), allocatable :: prcid(:)
integer(psb_ipk_) :: nesd, nerv,&
& err_act, i, idx_pt, totsnd_, totrcv_,&
& snd_pt, rcv_pt, pnti, n
integer(psb_ipk_) :: err_act, i, idx_pt, totsnd_, totrcv_,&
& snd_pt, rcv_pt, pnti
logical :: swap_mpi, swap_sync, swap_send, swap_recv,&
& albf,do_send,do_recv
logical, parameter :: usersend=.false., debug=.false.
@ -552,12 +551,11 @@ subroutine psi_ltran_vidx_multivect(ctxt,icomm,flag,beta,y,idx,&
integer(psb_ipk_), intent(in) :: totxch,totsnd, totrcv
! locals
integer(psb_ipk_) :: np, me
integer(psb_mpk_) :: np, me, nesd, nerv, n
integer(psb_mpk_) :: proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret
integer(psb_mpk_), allocatable :: prcid(:)
integer(psb_ipk_) :: nesd, nerv,&
& err_act, i, idx_pt, totsnd_, totrcv_,&
& snd_pt, rcv_pt, pnti, n
integer(psb_ipk_) :: err_act, i, idx_pt, totsnd_, totrcv_,&
& snd_pt, rcv_pt, pnti
logical :: swap_mpi, swap_sync, swap_send, swap_recv,&
& albf,do_send,do_recv
logical, parameter :: usersend=.false., debug=.false.

@ -98,7 +98,8 @@ subroutine psi_mswapdatam(flag,n,beta,y,desc_a,work,info,data)
include 'mpif.h'
#endif
integer(psb_ipk_), intent(in) :: flag, n
integer(psb_mpk_), intent(in) :: n
integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info
integer(psb_mpk_) :: y(:,:), beta
integer(psb_mpk_), target :: work(:)
@ -108,7 +109,8 @@ subroutine psi_mswapdatam(flag,n,beta,y,desc_a,work,info,data)
! locals
type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: icomm
integer(psb_ipk_) :: np, me, idxs, idxr, totxch, data_, err_act
integer(psb_mpk_) :: np, me
integer(psb_ipk_) :: idxs, idxr, totxch, data_, err_act
integer(psb_ipk_), pointer :: d_idx(:)
character(len=20) :: name
@ -171,7 +173,8 @@ subroutine psi_mswapidxm(ctxt,icomm,flag,n,beta,y,idx, &
type(psb_ctxt_type), intent(in) :: ctxt
integer(psb_mpk_), intent(in) :: icomm
integer(psb_ipk_), intent(in) :: flag,n
integer(psb_mpk_), intent(in) :: n
integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info
integer(psb_mpk_) :: y(:,:), beta
integer(psb_mpk_), target :: work(:)
@ -179,12 +182,11 @@ subroutine psi_mswapidxm(ctxt,icomm,flag,n,beta,y,idx, &
! locals
integer(psb_ipk_) :: np, me
integer(psb_mpk_) :: np, me, nesd, nerv
integer(psb_mpk_) :: proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret
integer(psb_mpk_), allocatable, dimension(:) :: bsdidx, brvidx,&
& sdsz, rvsz, prcid, rvhd, sdhd
integer(psb_ipk_) :: nesd, nerv,&
& err_act, i, idx_pt, totsnd_, totrcv_,&
integer(psb_ipk_) :: err_act, i, idx_pt, totsnd_, totrcv_,&
& snd_pt, rcv_pt, pnti
logical :: swap_mpi, swap_sync, swap_send, swap_recv,&
& albf,do_send,do_recv
@ -585,7 +587,8 @@ subroutine psi_mswapdatav(flag,beta,y,desc_a,work,info,data)
! locals
type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: icomm
integer(psb_ipk_) :: np, me, idxs, idxr, totxch, data_, err_act
integer(psb_mpk_) :: np, me
integer(psb_ipk_) :: idxs, idxr, totxch, data_, err_act
integer(psb_ipk_), pointer :: d_idx(:)
character(len=20) :: name
@ -666,13 +669,12 @@ subroutine psi_mswapidxv(ctxt,icomm,flag,beta,y,idx, &
integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv
! locals
integer(psb_ipk_) :: np, me
integer(psb_mpk_) :: np, me, nesd, nerv, n
integer(psb_mpk_) :: proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret
integer(psb_mpk_), allocatable, dimension(:) :: bsdidx, brvidx,&
& sdsz, rvsz, prcid, rvhd, sdhd
integer(psb_ipk_) :: nesd, nerv,&
& err_act, i, idx_pt, totsnd_, totrcv_,&
& snd_pt, rcv_pt, pnti, n
integer(psb_ipk_) :: err_act, i, idx_pt, totsnd_, totrcv_,&
& snd_pt, rcv_pt, pnti
logical :: swap_mpi, swap_sync, swap_send, swap_recv,&
& albf,do_send,do_recv
logical, parameter :: usersend=.false.

@ -102,7 +102,8 @@ subroutine psi_mswaptranm(flag,n,beta,y,desc_a,work,info,data)
include 'mpif.h'
#endif
integer(psb_ipk_), intent(in) :: flag, n
integer(psb_mpk_), intent(in) :: n
integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info
integer(psb_mpk_) :: y(:,:), beta
integer(psb_mpk_), target :: work(:)
@ -112,7 +113,8 @@ subroutine psi_mswaptranm(flag,n,beta,y,desc_a,work,info,data)
! locals
type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: icomm
integer(psb_ipk_) :: np, me, idxs, idxr, err_act, totxch, data_
integer(psb_mpk_) :: np, me
integer(psb_ipk_) :: idxs, idxr, err_act, totxch, data_
integer(psb_ipk_), pointer :: d_idx(:)
character(len=20) :: name
@ -176,19 +178,19 @@ subroutine psi_mtranidxm(ctxt,icomm,flag,n,beta,y,idx,&
type(psb_ctxt_type), intent(in) :: ctxt
integer(psb_mpk_), intent(in) :: icomm
integer(psb_ipk_), intent(in) :: flag,n
integer(psb_mpk_), intent(in) :: n
integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info
integer(psb_mpk_) :: y(:,:), beta
integer(psb_mpk_), target :: work(:)
integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv
! locals
integer(psb_ipk_) :: np, me
integer(psb_mpk_) :: np, me, nesd, nerv
integer(psb_mpk_) :: proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret
integer(psb_mpk_), allocatable, dimension(:) :: bsdidx, brvidx,&
& sdsz, rvsz, prcid, rvhd, sdhd
integer(psb_ipk_) :: nesd, nerv,&
& err_act, i, idx_pt, totsnd_, totrcv_,&
integer(psb_ipk_) :: err_act, i, idx_pt, totsnd_, totrcv_,&
& snd_pt, rcv_pt, pnti
logical :: swap_mpi, swap_sync, swap_send, swap_recv,&
& albf,do_send,do_recv
@ -678,13 +680,12 @@ subroutine psi_mtranidxv(ctxt,icomm,flag,beta,y,idx,&
integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv
! locals
integer(psb_ipk_) :: np, me
integer(psb_mpk_) :: np, me, nesd, nerv, n
integer(psb_mpk_) :: proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret
integer(psb_mpk_), allocatable, dimension(:) :: bsdidx, brvidx,&
& sdsz, rvsz, prcid, rvhd, sdhd
integer(psb_ipk_) :: nesd, nerv,&
& err_act, i, idx_pt, totsnd_, totrcv_,&
& snd_pt, rcv_pt, pnti, n
integer(psb_ipk_) :: err_act, i, idx_pt, totsnd_, totrcv_,&
& snd_pt, rcv_pt, pnti
logical :: swap_mpi, swap_sync, swap_send, swap_recv,&
& albf,do_send,do_recv
logical, parameter :: usersend=.false.

@ -48,7 +48,8 @@ subroutine psi_sovrl_restr_vect(x,xs,desc_a,info)
! locals
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, err_act, i, idx, isz
integer(psb_mpk_) :: np, me, isz
integer(psb_ipk_) :: err_act, i, idx
character(len=20) :: name, ch_err
name='psi_sovrl_restr_vect'
@ -91,7 +92,8 @@ subroutine psi_sovrl_restr_multivect(x,xs,desc_a,info)
! locals
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, err_act, i, idx, isz, nc
integer(psb_mpk_) :: np, me, isz,nc
integer(psb_ipk_) :: err_act, i, idx
character(len=20) :: name, ch_err
name='psi_sovrl_restr_mv'

@ -48,7 +48,8 @@ subroutine psi_sovrl_save_vect(x,xs,desc_a,info)
! locals
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, err_act, i, idx, isz
integer(psb_mpk_) :: np, me, isz
integer(psb_ipk_) :: err_act, i, idx
character(len=20) :: name, ch_err
name='psi_dovrl_saver1'
@ -97,7 +98,8 @@ subroutine psi_sovrl_save_multivect(x,xs,desc_a,info)
! locals
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, err_act, i, idx, isz, nc
integer(psb_mpk_) :: np, me, isz, nc
integer(psb_ipk_) :: err_act, i, idx
character(len=20) :: name, ch_err
name='psi_dovrl_saver1'

@ -51,7 +51,8 @@ subroutine psi_sovrl_upd_vect(x,desc_a,update,info)
! locals
real(psb_spk_), allocatable :: xs(:)
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, err_act, i, idx, ndm, nx
integer(psb_mpk_) :: np, me, isz, nx, ndm
integer(psb_ipk_) :: err_act, i, idx
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name, ch_err
@ -133,7 +134,8 @@ subroutine psi_sovrl_upd_multivect(x,desc_a,update,info)
! locals
real(psb_spk_), allocatable :: xs(:,:)
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, err_act, i, idx, ndm, nx, nc
integer(psb_mpk_) :: np, me, isz, ndm, nx, nc
integer(psb_ipk_) :: err_act, i, idx
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name, ch_err

@ -203,11 +203,11 @@ subroutine psi_sswap_vidx_vect(ctxt,icomm,flag,beta,y,idx, &
integer(psb_ipk_), intent(in) :: totxch,totsnd, totrcv
! locals
integer(psb_ipk_) :: np, me
integer(psb_mpk_) :: proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret
integer(psb_mpk_) :: np, me
integer(psb_mpk_) :: proc_to_comm, p2ptag, p2pstat(mpi_status_size),&
& iret, nesd, nerv
integer(psb_mpk_), allocatable :: prcid(:)
integer(psb_ipk_) :: nesd, nerv,&
& err_act, i, idx_pt, totsnd_, totrcv_,&
integer(psb_ipk_) :: err_act, i, idx_pt, totsnd_, totrcv_,&
& snd_pt, rcv_pt, pnti, n
logical :: swap_mpi, swap_sync, swap_send, swap_recv,&
& albf,do_send,do_recv
@ -541,12 +541,11 @@ subroutine psi_sswap_vidx_multivect(ctxt,icomm,flag,beta,y,idx, &
integer(psb_ipk_), intent(in) :: totxch,totsnd, totrcv
! locals
integer(psb_ipk_) :: np, me
integer(psb_mpk_) :: np, me, nesd, nerv, n
integer(psb_mpk_) :: proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret
integer(psb_mpk_), allocatable :: prcid(:)
integer(psb_ipk_) :: nesd, nerv,&
& err_act, i, idx_pt, totsnd_, totrcv_,&
& snd_pt, rcv_pt, pnti, n
integer(psb_ipk_) :: err_act, i, idx_pt, totsnd_, totrcv_,&
& snd_pt, rcv_pt, pnti
logical :: swap_mpi, swap_sync, swap_send, swap_recv,&
& albf,do_send,do_recv
logical, parameter :: usersend=.false., debug=.false.

@ -98,7 +98,8 @@ subroutine psi_sswapdatam(flag,n,beta,y,desc_a,work,info,data)
include 'mpif.h'
#endif
integer(psb_ipk_), intent(in) :: flag, n
integer(psb_mpk_), intent(in) :: n
integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info
real(psb_spk_) :: y(:,:), beta
real(psb_spk_), target :: work(:)
@ -108,7 +109,8 @@ subroutine psi_sswapdatam(flag,n,beta,y,desc_a,work,info,data)
! locals
type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: icomm
integer(psb_ipk_) :: np, me, idxs, idxr, totxch, data_, err_act
integer(psb_mpk_) :: np, me
integer(psb_ipk_) :: idxs, idxr, totxch, data_, err_act
integer(psb_ipk_), pointer :: d_idx(:)
character(len=20) :: name
@ -171,7 +173,8 @@ subroutine psi_sswapidxm(ctxt,icomm,flag,n,beta,y,idx, &
type(psb_ctxt_type), intent(in) :: ctxt
integer(psb_mpk_), intent(in) :: icomm
integer(psb_ipk_), intent(in) :: flag,n
integer(psb_mpk_), intent(in) :: n
integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info
real(psb_spk_) :: y(:,:), beta
real(psb_spk_), target :: work(:)
@ -179,12 +182,11 @@ subroutine psi_sswapidxm(ctxt,icomm,flag,n,beta,y,idx, &
! locals
integer(psb_ipk_) :: np, me
integer(psb_mpk_) :: np, me, nesd, nerv
integer(psb_mpk_) :: proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret
integer(psb_mpk_), allocatable, dimension(:) :: bsdidx, brvidx,&
& sdsz, rvsz, prcid, rvhd, sdhd
integer(psb_ipk_) :: nesd, nerv,&
& err_act, i, idx_pt, totsnd_, totrcv_,&
integer(psb_ipk_) :: err_act, i, idx_pt, totsnd_, totrcv_,&
& snd_pt, rcv_pt, pnti
logical :: swap_mpi, swap_sync, swap_send, swap_recv,&
& albf,do_send,do_recv
@ -585,7 +587,8 @@ subroutine psi_sswapdatav(flag,beta,y,desc_a,work,info,data)
! locals
type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: icomm
integer(psb_ipk_) :: np, me, idxs, idxr, totxch, data_, err_act
integer(psb_mpk_) :: np, me
integer(psb_ipk_) :: idxs, idxr, totxch, data_, err_act
integer(psb_ipk_), pointer :: d_idx(:)
character(len=20) :: name
@ -666,13 +669,12 @@ subroutine psi_sswapidxv(ctxt,icomm,flag,beta,y,idx, &
integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv
! locals
integer(psb_ipk_) :: np, me
integer(psb_mpk_) :: np, me, nesd, nerv, n
integer(psb_mpk_) :: proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret
integer(psb_mpk_), allocatable, dimension(:) :: bsdidx, brvidx,&
& sdsz, rvsz, prcid, rvhd, sdhd
integer(psb_ipk_) :: nesd, nerv,&
& err_act, i, idx_pt, totsnd_, totrcv_,&
& snd_pt, rcv_pt, pnti, n
integer(psb_ipk_) :: err_act, i, idx_pt, totsnd_, totrcv_,&
& snd_pt, rcv_pt, pnti
logical :: swap_mpi, swap_sync, swap_send, swap_recv,&
& albf,do_send,do_recv
logical, parameter :: usersend=.false.

@ -204,12 +204,11 @@ subroutine psi_stran_vidx_vect(ctxt,icomm,flag,beta,y,idx,&
integer(psb_ipk_), intent(in) :: totxch,totsnd, totrcv
! locals
integer(psb_ipk_) :: np, me
integer(psb_mpk_) :: np, me, nesd, nerv, n
integer(psb_mpk_) :: proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret
integer(psb_mpk_), allocatable :: prcid(:)
integer(psb_ipk_) :: nesd, nerv,&
& err_act, i, idx_pt, totsnd_, totrcv_,&
& snd_pt, rcv_pt, pnti, n
integer(psb_ipk_) :: err_act, i, idx_pt, totsnd_, totrcv_,&
& snd_pt, rcv_pt, pnti
logical :: swap_mpi, swap_sync, swap_send, swap_recv,&
& albf,do_send,do_recv
logical, parameter :: usersend=.false., debug=.false.
@ -552,12 +551,11 @@ subroutine psi_stran_vidx_multivect(ctxt,icomm,flag,beta,y,idx,&
integer(psb_ipk_), intent(in) :: totxch,totsnd, totrcv
! locals
integer(psb_ipk_) :: np, me
integer(psb_mpk_) :: np, me, nesd, nerv, n
integer(psb_mpk_) :: proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret
integer(psb_mpk_), allocatable :: prcid(:)
integer(psb_ipk_) :: nesd, nerv,&
& err_act, i, idx_pt, totsnd_, totrcv_,&
& snd_pt, rcv_pt, pnti, n
integer(psb_ipk_) :: err_act, i, idx_pt, totsnd_, totrcv_,&
& snd_pt, rcv_pt, pnti
logical :: swap_mpi, swap_sync, swap_send, swap_recv,&
& albf,do_send,do_recv
logical, parameter :: usersend=.false., debug=.false.

@ -102,7 +102,8 @@ subroutine psi_sswaptranm(flag,n,beta,y,desc_a,work,info,data)
include 'mpif.h'
#endif
integer(psb_ipk_), intent(in) :: flag, n
integer(psb_mpk_), intent(in) :: n
integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info
real(psb_spk_) :: y(:,:), beta
real(psb_spk_), target :: work(:)
@ -112,7 +113,8 @@ subroutine psi_sswaptranm(flag,n,beta,y,desc_a,work,info,data)
! locals
type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: icomm
integer(psb_ipk_) :: np, me, idxs, idxr, err_act, totxch, data_
integer(psb_mpk_) :: np, me
integer(psb_ipk_) :: idxs, idxr, err_act, totxch, data_
integer(psb_ipk_), pointer :: d_idx(:)
character(len=20) :: name
@ -176,19 +178,19 @@ subroutine psi_stranidxm(ctxt,icomm,flag,n,beta,y,idx,&
type(psb_ctxt_type), intent(in) :: ctxt
integer(psb_mpk_), intent(in) :: icomm
integer(psb_ipk_), intent(in) :: flag,n
integer(psb_mpk_), intent(in) :: n
integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info
real(psb_spk_) :: y(:,:), beta
real(psb_spk_), target :: work(:)
integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv
! locals
integer(psb_ipk_) :: np, me
integer(psb_mpk_) :: np, me, nesd, nerv
integer(psb_mpk_) :: proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret
integer(psb_mpk_), allocatable, dimension(:) :: bsdidx, brvidx,&
& sdsz, rvsz, prcid, rvhd, sdhd
integer(psb_ipk_) :: nesd, nerv,&
& err_act, i, idx_pt, totsnd_, totrcv_,&
integer(psb_ipk_) :: err_act, i, idx_pt, totsnd_, totrcv_,&
& snd_pt, rcv_pt, pnti
logical :: swap_mpi, swap_sync, swap_send, swap_recv,&
& albf,do_send,do_recv
@ -678,13 +680,12 @@ subroutine psi_stranidxv(ctxt,icomm,flag,beta,y,idx,&
integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv
! locals
integer(psb_ipk_) :: np, me
integer(psb_mpk_) :: np, me, nesd, nerv, n
integer(psb_mpk_) :: proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret
integer(psb_mpk_), allocatable, dimension(:) :: bsdidx, brvidx,&
& sdsz, rvsz, prcid, rvhd, sdhd
integer(psb_ipk_) :: nesd, nerv,&
& err_act, i, idx_pt, totsnd_, totrcv_,&
& snd_pt, rcv_pt, pnti, n
integer(psb_ipk_) :: err_act, i, idx_pt, totsnd_, totrcv_,&
& snd_pt, rcv_pt, pnti
logical :: swap_mpi, swap_sync, swap_send, swap_recv,&
& albf,do_send,do_recv
logical, parameter :: usersend=.false.

@ -48,7 +48,8 @@ subroutine psi_zovrl_restr_vect(x,xs,desc_a,info)
! locals
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, err_act, i, idx, isz
integer(psb_mpk_) :: np, me, isz
integer(psb_ipk_) :: err_act, i, idx
character(len=20) :: name, ch_err
name='psi_zovrl_restr_vect'
@ -91,7 +92,8 @@ subroutine psi_zovrl_restr_multivect(x,xs,desc_a,info)
! locals
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, err_act, i, idx, isz, nc
integer(psb_mpk_) :: np, me, isz,nc
integer(psb_ipk_) :: err_act, i, idx
character(len=20) :: name, ch_err
name='psi_zovrl_restr_mv'

@ -48,7 +48,8 @@ subroutine psi_zovrl_save_vect(x,xs,desc_a,info)
! locals
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, err_act, i, idx, isz
integer(psb_mpk_) :: np, me, isz
integer(psb_ipk_) :: err_act, i, idx
character(len=20) :: name, ch_err
name='psi_dovrl_saver1'
@ -97,7 +98,8 @@ subroutine psi_zovrl_save_multivect(x,xs,desc_a,info)
! locals
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, err_act, i, idx, isz, nc
integer(psb_mpk_) :: np, me, isz, nc
integer(psb_ipk_) :: err_act, i, idx
character(len=20) :: name, ch_err
name='psi_dovrl_saver1'

@ -51,7 +51,8 @@ subroutine psi_zovrl_upd_vect(x,desc_a,update,info)
! locals
complex(psb_dpk_), allocatable :: xs(:)
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, err_act, i, idx, ndm, nx
integer(psb_mpk_) :: np, me, isz, nx, ndm
integer(psb_ipk_) :: err_act, i, idx
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name, ch_err
@ -133,7 +134,8 @@ subroutine psi_zovrl_upd_multivect(x,desc_a,update,info)
! locals
complex(psb_dpk_), allocatable :: xs(:,:)
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, err_act, i, idx, ndm, nx, nc
integer(psb_mpk_) :: np, me, isz, ndm, nx, nc
integer(psb_ipk_) :: err_act, i, idx
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name, ch_err

@ -203,11 +203,11 @@ subroutine psi_zswap_vidx_vect(ctxt,icomm,flag,beta,y,idx, &
integer(psb_ipk_), intent(in) :: totxch,totsnd, totrcv
! locals
integer(psb_ipk_) :: np, me
integer(psb_mpk_) :: proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret
integer(psb_mpk_) :: np, me
integer(psb_mpk_) :: proc_to_comm, p2ptag, p2pstat(mpi_status_size),&
& iret, nesd, nerv
integer(psb_mpk_), allocatable :: prcid(:)
integer(psb_ipk_) :: nesd, nerv,&
& err_act, i, idx_pt, totsnd_, totrcv_,&
integer(psb_ipk_) :: err_act, i, idx_pt, totsnd_, totrcv_,&
& snd_pt, rcv_pt, pnti, n
logical :: swap_mpi, swap_sync, swap_send, swap_recv,&
& albf,do_send,do_recv
@ -541,12 +541,11 @@ subroutine psi_zswap_vidx_multivect(ctxt,icomm,flag,beta,y,idx, &
integer(psb_ipk_), intent(in) :: totxch,totsnd, totrcv
! locals
integer(psb_ipk_) :: np, me
integer(psb_mpk_) :: np, me, nesd, nerv, n
integer(psb_mpk_) :: proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret
integer(psb_mpk_), allocatable :: prcid(:)
integer(psb_ipk_) :: nesd, nerv,&
& err_act, i, idx_pt, totsnd_, totrcv_,&
& snd_pt, rcv_pt, pnti, n
integer(psb_ipk_) :: err_act, i, idx_pt, totsnd_, totrcv_,&
& snd_pt, rcv_pt, pnti
logical :: swap_mpi, swap_sync, swap_send, swap_recv,&
& albf,do_send,do_recv
logical, parameter :: usersend=.false., debug=.false.

@ -98,7 +98,8 @@ subroutine psi_zswapdatam(flag,n,beta,y,desc_a,work,info,data)
include 'mpif.h'
#endif
integer(psb_ipk_), intent(in) :: flag, n
integer(psb_mpk_), intent(in) :: n
integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info
complex(psb_dpk_) :: y(:,:), beta
complex(psb_dpk_), target :: work(:)
@ -108,7 +109,8 @@ subroutine psi_zswapdatam(flag,n,beta,y,desc_a,work,info,data)
! locals
type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: icomm
integer(psb_ipk_) :: np, me, idxs, idxr, totxch, data_, err_act
integer(psb_mpk_) :: np, me
integer(psb_ipk_) :: idxs, idxr, totxch, data_, err_act
integer(psb_ipk_), pointer :: d_idx(:)
character(len=20) :: name
@ -171,7 +173,8 @@ subroutine psi_zswapidxm(ctxt,icomm,flag,n,beta,y,idx, &
type(psb_ctxt_type), intent(in) :: ctxt
integer(psb_mpk_), intent(in) :: icomm
integer(psb_ipk_), intent(in) :: flag,n
integer(psb_mpk_), intent(in) :: n
integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info
complex(psb_dpk_) :: y(:,:), beta
complex(psb_dpk_), target :: work(:)
@ -179,12 +182,11 @@ subroutine psi_zswapidxm(ctxt,icomm,flag,n,beta,y,idx, &
! locals
integer(psb_ipk_) :: np, me
integer(psb_mpk_) :: np, me, nesd, nerv
integer(psb_mpk_) :: proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret
integer(psb_mpk_), allocatable, dimension(:) :: bsdidx, brvidx,&
& sdsz, rvsz, prcid, rvhd, sdhd
integer(psb_ipk_) :: nesd, nerv,&
& err_act, i, idx_pt, totsnd_, totrcv_,&
integer(psb_ipk_) :: err_act, i, idx_pt, totsnd_, totrcv_,&
& snd_pt, rcv_pt, pnti
logical :: swap_mpi, swap_sync, swap_send, swap_recv,&
& albf,do_send,do_recv
@ -585,7 +587,8 @@ subroutine psi_zswapdatav(flag,beta,y,desc_a,work,info,data)
! locals
type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: icomm
integer(psb_ipk_) :: np, me, idxs, idxr, totxch, data_, err_act
integer(psb_mpk_) :: np, me
integer(psb_ipk_) :: idxs, idxr, totxch, data_, err_act
integer(psb_ipk_), pointer :: d_idx(:)
character(len=20) :: name
@ -666,13 +669,12 @@ subroutine psi_zswapidxv(ctxt,icomm,flag,beta,y,idx, &
integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv
! locals
integer(psb_ipk_) :: np, me
integer(psb_mpk_) :: np, me, nesd, nerv, n
integer(psb_mpk_) :: proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret
integer(psb_mpk_), allocatable, dimension(:) :: bsdidx, brvidx,&
& sdsz, rvsz, prcid, rvhd, sdhd
integer(psb_ipk_) :: nesd, nerv,&
& err_act, i, idx_pt, totsnd_, totrcv_,&
& snd_pt, rcv_pt, pnti, n
integer(psb_ipk_) :: err_act, i, idx_pt, totsnd_, totrcv_,&
& snd_pt, rcv_pt, pnti
logical :: swap_mpi, swap_sync, swap_send, swap_recv,&
& albf,do_send,do_recv
logical, parameter :: usersend=.false.

@ -204,12 +204,11 @@ subroutine psi_ztran_vidx_vect(ctxt,icomm,flag,beta,y,idx,&
integer(psb_ipk_), intent(in) :: totxch,totsnd, totrcv
! locals
integer(psb_ipk_) :: np, me
integer(psb_mpk_) :: np, me, nesd, nerv, n
integer(psb_mpk_) :: proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret
integer(psb_mpk_), allocatable :: prcid(:)
integer(psb_ipk_) :: nesd, nerv,&
& err_act, i, idx_pt, totsnd_, totrcv_,&
& snd_pt, rcv_pt, pnti, n
integer(psb_ipk_) :: err_act, i, idx_pt, totsnd_, totrcv_,&
& snd_pt, rcv_pt, pnti
logical :: swap_mpi, swap_sync, swap_send, swap_recv,&
& albf,do_send,do_recv
logical, parameter :: usersend=.false., debug=.false.
@ -552,12 +551,11 @@ subroutine psi_ztran_vidx_multivect(ctxt,icomm,flag,beta,y,idx,&
integer(psb_ipk_), intent(in) :: totxch,totsnd, totrcv
! locals
integer(psb_ipk_) :: np, me
integer(psb_mpk_) :: np, me, nesd, nerv, n
integer(psb_mpk_) :: proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret
integer(psb_mpk_), allocatable :: prcid(:)
integer(psb_ipk_) :: nesd, nerv,&
& err_act, i, idx_pt, totsnd_, totrcv_,&
& snd_pt, rcv_pt, pnti, n
integer(psb_ipk_) :: err_act, i, idx_pt, totsnd_, totrcv_,&
& snd_pt, rcv_pt, pnti
logical :: swap_mpi, swap_sync, swap_send, swap_recv,&
& albf,do_send,do_recv
logical, parameter :: usersend=.false., debug=.false.

@ -102,7 +102,8 @@ subroutine psi_zswaptranm(flag,n,beta,y,desc_a,work,info,data)
include 'mpif.h'
#endif
integer(psb_ipk_), intent(in) :: flag, n
integer(psb_mpk_), intent(in) :: n
integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info
complex(psb_dpk_) :: y(:,:), beta
complex(psb_dpk_), target :: work(:)
@ -112,7 +113,8 @@ subroutine psi_zswaptranm(flag,n,beta,y,desc_a,work,info,data)
! locals
type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: icomm
integer(psb_ipk_) :: np, me, idxs, idxr, err_act, totxch, data_
integer(psb_mpk_) :: np, me
integer(psb_ipk_) :: idxs, idxr, err_act, totxch, data_
integer(psb_ipk_), pointer :: d_idx(:)
character(len=20) :: name
@ -176,19 +178,19 @@ subroutine psi_ztranidxm(ctxt,icomm,flag,n,beta,y,idx,&
type(psb_ctxt_type), intent(in) :: ctxt
integer(psb_mpk_), intent(in) :: icomm
integer(psb_ipk_), intent(in) :: flag,n
integer(psb_mpk_), intent(in) :: n
integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info
complex(psb_dpk_) :: y(:,:), beta
complex(psb_dpk_), target :: work(:)
integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv
! locals
integer(psb_ipk_) :: np, me
integer(psb_mpk_) :: np, me, nesd, nerv
integer(psb_mpk_) :: proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret
integer(psb_mpk_), allocatable, dimension(:) :: bsdidx, brvidx,&
& sdsz, rvsz, prcid, rvhd, sdhd
integer(psb_ipk_) :: nesd, nerv,&
& err_act, i, idx_pt, totsnd_, totrcv_,&
integer(psb_ipk_) :: err_act, i, idx_pt, totsnd_, totrcv_,&
& snd_pt, rcv_pt, pnti
logical :: swap_mpi, swap_sync, swap_send, swap_recv,&
& albf,do_send,do_recv
@ -678,13 +680,12 @@ subroutine psi_ztranidxv(ctxt,icomm,flag,beta,y,idx,&
integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv
! locals
integer(psb_ipk_) :: np, me
integer(psb_mpk_) :: np, me, nesd, nerv, n
integer(psb_mpk_) :: proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret
integer(psb_mpk_), allocatable, dimension(:) :: bsdidx, brvidx,&
& sdsz, rvsz, prcid, rvhd, sdhd
integer(psb_ipk_) :: nesd, nerv,&
& err_act, i, idx_pt, totsnd_, totrcv_,&
& snd_pt, rcv_pt, pnti, n
integer(psb_ipk_) :: err_act, i, idx_pt, totsnd_, totrcv_,&
& snd_pt, rcv_pt, pnti
logical :: swap_mpi, swap_sync, swap_send, swap_recv,&
& albf,do_send,do_recv
logical, parameter :: usersend=.false.

@ -66,8 +66,8 @@ subroutine psb_chalom(x,desc_a,info,jx,ik,work,tran,mode,data)
! locals
type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: np, me
integer(psb_ipk_) :: err_act, iix, jjx, k, maxk, nrow, imode, i,&
integer(psb_mpk_) :: np, me, k
integer(psb_ipk_) :: err_act, iix, jjx, maxk, nrow, imode, i,&
& liwork,data_, ldx
integer(psb_lpk_) :: m, n, ix, ijx
complex(psb_spk_),pointer :: iwork(:), xp(:,:)

@ -77,8 +77,8 @@ subroutine psb_covrlm(x,desc_a,info,jx,ik,work,update,mode)
! locals
type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: np, me
integer(psb_ipk_) :: err_act, iix, jjx, nrow, ncol, k, maxk, update_,&
integer(psb_mpk_) :: np, me, k
integer(psb_ipk_) :: err_act, iix, jjx, nrow, ncol, maxk, update_,&
& mode_, liwork, ldx
integer(psb_lpk_) :: m, n, ix, ijx
complex(psb_spk_),pointer :: iwork(:), xp(:,:)

@ -63,7 +63,8 @@ subroutine psb_cscatterm(globx, locx, desc_a, info, root)
! locals
type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: np, me, iroot, icomm, myrank, rootrank, iam, nlr
integer(psb_mpk_) :: np, me, iroot, icomm, myrank, rootrank, iam,&
& nlr, minfo
integer(psb_ipk_) :: ierr(5), err_act, nrow,&
& ilocx, jlocx, lda_locx, lda_globx, lock, globk, k, maxk, &
& col,pos
@ -167,8 +168,8 @@ subroutine psb_cscatterm(globx, locx, desc_a, info, root)
!
nlr = nrow
call mpi_gather(nlr,1,psb_mpi_mpk_,all_dim,&
& 1,psb_mpi_mpk_,rootrank,icomm,info)
& 1,psb_mpi_mpk_,rootrank,icomm,minfo)
info = minfo
if (iam == iroot) then
displ(1)=0
do i=2,np
@ -195,8 +196,8 @@ subroutine psb_cscatterm(globx, locx, desc_a, info, root)
call mpi_gatherv(ltg,nlr,&
& psb_mpi_lpk_,l_t_g_all,all_dim,&
& displ,psb_mpi_lpk_,rootrank,icomm,info)
& displ,psb_mpi_lpk_,rootrank,icomm,minfo)
info = minfo
do col=1, k
! prepare vector to scatter
if(iam == iroot) then
@ -211,9 +212,9 @@ subroutine psb_cscatterm(globx, locx, desc_a, info, root)
! scatter
call mpi_scatterv(scatterv,all_dim,displ,&
& psb_mpi_c_spk_,locx(1,col),nrow,&
& psb_mpi_c_spk_,rootrank,icomm,info)
& psb_mpi_c_spk_,locx(1,col),nlr,&
& psb_mpi_c_spk_,rootrank,icomm,minfo)
info = minfo
end do
deallocate(l_t_g_all, scatterv,stat=info)
@ -308,7 +309,7 @@ subroutine psb_cscatterv(globx, locx, desc_a, info, root)
! locals
type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: np, iam, iroot, iiroot, icomm, myrank, rootrank, nlr
integer(psb_mpk_) :: np, iam, iroot, iiroot, icomm, myrank, rootrank, nlr, minfo
integer(psb_ipk_) :: ierr(5), err_act, nrow,&
& ilocx, jlocx, lda_locx, lda_globx, k, pos, ilx, jlx
integer(psb_lpk_) :: m, n, i, j, idx, iglobx, jglobx
@ -403,8 +404,8 @@ subroutine psb_cscatterv(globx, locx, desc_a, info, root)
!
nlr = nrow
call mpi_gather(nlr,1,psb_mpi_mpk_,all_dim,&
& 1,psb_mpi_mpk_,rootrank,icomm,info)
& 1,psb_mpi_mpk_,rootrank,icomm,minfo)
info = minfo
if(iam == iroot) then
displ(1)=0
do i=2,np
@ -436,8 +437,8 @@ subroutine psb_cscatterv(globx, locx, desc_a, info, root)
call mpi_gatherv(ltg,nlr,&
& psb_mpi_lpk_,l_t_g_all,all_dim,&
& displ,psb_mpi_lpk_,rootrank,icomm,info)
& displ,psb_mpi_lpk_,rootrank,icomm,minfo)
info = minfo
! prepare vector to scatter
if (iam == iroot) then
do i=1,np
@ -451,9 +452,9 @@ subroutine psb_cscatterv(globx, locx, desc_a, info, root)
end if
call mpi_scatterv(scatterv,all_dim,displ,&
& psb_mpi_c_spk_,locx,nrow,&
& psb_mpi_c_spk_,rootrank,icomm,info)
& psb_mpi_c_spk_,locx,nlr,&
& psb_mpi_c_spk_,rootrank,icomm,minfo)
info = minfo
deallocate(l_t_g_all, scatterv,stat=info)
if(info /= psb_success_) then
info=psb_err_from_subroutine_

@ -66,8 +66,8 @@ subroutine psb_dhalom(x,desc_a,info,jx,ik,work,tran,mode,data)
! locals
type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: np, me
integer(psb_ipk_) :: err_act, iix, jjx, k, maxk, nrow, imode, i,&
integer(psb_mpk_) :: np, me, k
integer(psb_ipk_) :: err_act, iix, jjx, maxk, nrow, imode, i,&
& liwork,data_, ldx
integer(psb_lpk_) :: m, n, ix, ijx
real(psb_dpk_),pointer :: iwork(:), xp(:,:)

@ -77,8 +77,8 @@ subroutine psb_dovrlm(x,desc_a,info,jx,ik,work,update,mode)
! locals
type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: np, me
integer(psb_ipk_) :: err_act, iix, jjx, nrow, ncol, k, maxk, update_,&
integer(psb_mpk_) :: np, me, k
integer(psb_ipk_) :: err_act, iix, jjx, nrow, ncol, maxk, update_,&
& mode_, liwork, ldx
integer(psb_lpk_) :: m, n, ix, ijx
real(psb_dpk_),pointer :: iwork(:), xp(:,:)

@ -63,7 +63,8 @@ subroutine psb_dscatterm(globx, locx, desc_a, info, root)
! locals
type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: np, me, iroot, icomm, myrank, rootrank, iam, nlr
integer(psb_mpk_) :: np, me, iroot, icomm, myrank, rootrank, iam,&
& nlr, minfo
integer(psb_ipk_) :: ierr(5), err_act, nrow,&
& ilocx, jlocx, lda_locx, lda_globx, lock, globk, k, maxk, &
& col,pos
@ -167,8 +168,8 @@ subroutine psb_dscatterm(globx, locx, desc_a, info, root)
!
nlr = nrow
call mpi_gather(nlr,1,psb_mpi_mpk_,all_dim,&
& 1,psb_mpi_mpk_,rootrank,icomm,info)
& 1,psb_mpi_mpk_,rootrank,icomm,minfo)
info = minfo
if (iam == iroot) then
displ(1)=0
do i=2,np
@ -195,8 +196,8 @@ subroutine psb_dscatterm(globx, locx, desc_a, info, root)
call mpi_gatherv(ltg,nlr,&
& psb_mpi_lpk_,l_t_g_all,all_dim,&
& displ,psb_mpi_lpk_,rootrank,icomm,info)
& displ,psb_mpi_lpk_,rootrank,icomm,minfo)
info = minfo
do col=1, k
! prepare vector to scatter
if(iam == iroot) then
@ -211,9 +212,9 @@ subroutine psb_dscatterm(globx, locx, desc_a, info, root)
! scatter
call mpi_scatterv(scatterv,all_dim,displ,&
& psb_mpi_r_dpk_,locx(1,col),nrow,&
& psb_mpi_r_dpk_,rootrank,icomm,info)
& psb_mpi_r_dpk_,locx(1,col),nlr,&
& psb_mpi_r_dpk_,rootrank,icomm,minfo)
info = minfo
end do
deallocate(l_t_g_all, scatterv,stat=info)
@ -308,7 +309,7 @@ subroutine psb_dscatterv(globx, locx, desc_a, info, root)
! locals
type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: np, iam, iroot, iiroot, icomm, myrank, rootrank, nlr
integer(psb_mpk_) :: np, iam, iroot, iiroot, icomm, myrank, rootrank, nlr, minfo
integer(psb_ipk_) :: ierr(5), err_act, nrow,&
& ilocx, jlocx, lda_locx, lda_globx, k, pos, ilx, jlx
integer(psb_lpk_) :: m, n, i, j, idx, iglobx, jglobx
@ -403,8 +404,8 @@ subroutine psb_dscatterv(globx, locx, desc_a, info, root)
!
nlr = nrow
call mpi_gather(nlr,1,psb_mpi_mpk_,all_dim,&
& 1,psb_mpi_mpk_,rootrank,icomm,info)
& 1,psb_mpi_mpk_,rootrank,icomm,minfo)
info = minfo
if(iam == iroot) then
displ(1)=0
do i=2,np
@ -436,8 +437,8 @@ subroutine psb_dscatterv(globx, locx, desc_a, info, root)
call mpi_gatherv(ltg,nlr,&
& psb_mpi_lpk_,l_t_g_all,all_dim,&
& displ,psb_mpi_lpk_,rootrank,icomm,info)
& displ,psb_mpi_lpk_,rootrank,icomm,minfo)
info = minfo
! prepare vector to scatter
if (iam == iroot) then
do i=1,np
@ -451,9 +452,9 @@ subroutine psb_dscatterv(globx, locx, desc_a, info, root)
end if
call mpi_scatterv(scatterv,all_dim,displ,&
& psb_mpi_r_dpk_,locx,nrow,&
& psb_mpi_r_dpk_,rootrank,icomm,info)
& psb_mpi_r_dpk_,locx,nlr,&
& psb_mpi_r_dpk_,rootrank,icomm,minfo)
info = minfo
deallocate(l_t_g_all, scatterv,stat=info)
if(info /= psb_success_) then
info=psb_err_from_subroutine_

@ -66,8 +66,8 @@ subroutine psb_ehalom(x,desc_a,info,jx,ik,work,tran,mode,data)
! locals
type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: np, me
integer(psb_ipk_) :: err_act, iix, jjx, k, maxk, nrow, imode, i,&
integer(psb_mpk_) :: np, me, k
integer(psb_ipk_) :: err_act, iix, jjx, maxk, nrow, imode, i,&
& liwork,data_, ldx
integer(psb_lpk_) :: m, n, ix, ijx
integer(psb_epk_),pointer :: iwork(:), xp(:,:)

@ -77,8 +77,8 @@ subroutine psb_eovrlm(x,desc_a,info,jx,ik,work,update,mode)
! locals
type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: np, me
integer(psb_ipk_) :: err_act, iix, jjx, nrow, ncol, k, maxk, update_,&
integer(psb_mpk_) :: np, me, k
integer(psb_ipk_) :: err_act, iix, jjx, nrow, ncol, maxk, update_,&
& mode_, liwork, ldx
integer(psb_lpk_) :: m, n, ix, ijx
integer(psb_epk_),pointer :: iwork(:), xp(:,:)

@ -63,7 +63,8 @@ subroutine psb_escatterm(globx, locx, desc_a, info, root)
! locals
type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: np, me, iroot, icomm, myrank, rootrank, iam, nlr
integer(psb_mpk_) :: np, me, iroot, icomm, myrank, rootrank, iam,&
& nlr, minfo
integer(psb_ipk_) :: ierr(5), err_act, nrow,&
& ilocx, jlocx, lda_locx, lda_globx, lock, globk, k, maxk, &
& col,pos
@ -167,8 +168,8 @@ subroutine psb_escatterm(globx, locx, desc_a, info, root)
!
nlr = nrow
call mpi_gather(nlr,1,psb_mpi_mpk_,all_dim,&
& 1,psb_mpi_mpk_,rootrank,icomm,info)
& 1,psb_mpi_mpk_,rootrank,icomm,minfo)
info = minfo
if (iam == iroot) then
displ(1)=0
do i=2,np
@ -195,8 +196,8 @@ subroutine psb_escatterm(globx, locx, desc_a, info, root)
call mpi_gatherv(ltg,nlr,&
& psb_mpi_lpk_,l_t_g_all,all_dim,&
& displ,psb_mpi_lpk_,rootrank,icomm,info)
& displ,psb_mpi_lpk_,rootrank,icomm,minfo)
info = minfo
do col=1, k
! prepare vector to scatter
if(iam == iroot) then
@ -211,9 +212,9 @@ subroutine psb_escatterm(globx, locx, desc_a, info, root)
! scatter
call mpi_scatterv(scatterv,all_dim,displ,&
& psb_mpi_epk_,locx(1,col),nrow,&
& psb_mpi_epk_,rootrank,icomm,info)
& psb_mpi_epk_,locx(1,col),nlr,&
& psb_mpi_epk_,rootrank,icomm,minfo)
info = minfo
end do
deallocate(l_t_g_all, scatterv,stat=info)
@ -308,7 +309,7 @@ subroutine psb_escatterv(globx, locx, desc_a, info, root)
! locals
type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: np, iam, iroot, iiroot, icomm, myrank, rootrank, nlr
integer(psb_mpk_) :: np, iam, iroot, iiroot, icomm, myrank, rootrank, nlr, minfo
integer(psb_ipk_) :: ierr(5), err_act, nrow,&
& ilocx, jlocx, lda_locx, lda_globx, k, pos, ilx, jlx
integer(psb_lpk_) :: m, n, i, j, idx, iglobx, jglobx
@ -403,8 +404,8 @@ subroutine psb_escatterv(globx, locx, desc_a, info, root)
!
nlr = nrow
call mpi_gather(nlr,1,psb_mpi_mpk_,all_dim,&
& 1,psb_mpi_mpk_,rootrank,icomm,info)
& 1,psb_mpi_mpk_,rootrank,icomm,minfo)
info = minfo
if(iam == iroot) then
displ(1)=0
do i=2,np
@ -436,8 +437,8 @@ subroutine psb_escatterv(globx, locx, desc_a, info, root)
call mpi_gatherv(ltg,nlr,&
& psb_mpi_lpk_,l_t_g_all,all_dim,&
& displ,psb_mpi_lpk_,rootrank,icomm,info)
& displ,psb_mpi_lpk_,rootrank,icomm,minfo)
info = minfo
! prepare vector to scatter
if (iam == iroot) then
do i=1,np
@ -451,9 +452,9 @@ subroutine psb_escatterv(globx, locx, desc_a, info, root)
end if
call mpi_scatterv(scatterv,all_dim,displ,&
& psb_mpi_epk_,locx,nrow,&
& psb_mpi_epk_,rootrank,icomm,info)
& psb_mpi_epk_,locx,nlr,&
& psb_mpi_epk_,rootrank,icomm,minfo)
info = minfo
deallocate(l_t_g_all, scatterv,stat=info)
if(info /= psb_success_) then
info=psb_err_from_subroutine_

@ -66,8 +66,8 @@ subroutine psb_i2halom(x,desc_a,info,jx,ik,work,tran,mode,data)
! locals
type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: np, me
integer(psb_ipk_) :: err_act, iix, jjx, k, maxk, nrow, imode, i,&
integer(psb_mpk_) :: np, me, k
integer(psb_ipk_) :: err_act, iix, jjx, maxk, nrow, imode, i,&
& liwork,data_, ldx
integer(psb_lpk_) :: m, n, ix, ijx
integer(psb_i2pk_),pointer :: iwork(:), xp(:,:)

@ -77,8 +77,8 @@ subroutine psb_i2ovrlm(x,desc_a,info,jx,ik,work,update,mode)
! locals
type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: np, me
integer(psb_ipk_) :: err_act, iix, jjx, nrow, ncol, k, maxk, update_,&
integer(psb_mpk_) :: np, me, k
integer(psb_ipk_) :: err_act, iix, jjx, nrow, ncol, maxk, update_,&
& mode_, liwork, ldx
integer(psb_lpk_) :: m, n, ix, ijx
integer(psb_i2pk_),pointer :: iwork(:), xp(:,:)

@ -63,7 +63,8 @@ subroutine psb_i2scatterm(globx, locx, desc_a, info, root)
! locals
type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: np, me, iroot, icomm, myrank, rootrank, iam, nlr
integer(psb_mpk_) :: np, me, iroot, icomm, myrank, rootrank, iam,&
& nlr, minfo
integer(psb_ipk_) :: ierr(5), err_act, nrow,&
& ilocx, jlocx, lda_locx, lda_globx, lock, globk, k, maxk, &
& col,pos
@ -167,8 +168,8 @@ subroutine psb_i2scatterm(globx, locx, desc_a, info, root)
!
nlr = nrow
call mpi_gather(nlr,1,psb_mpi_mpk_,all_dim,&
& 1,psb_mpi_mpk_,rootrank,icomm,info)
& 1,psb_mpi_mpk_,rootrank,icomm,minfo)
info = minfo
if (iam == iroot) then
displ(1)=0
do i=2,np
@ -195,8 +196,8 @@ subroutine psb_i2scatterm(globx, locx, desc_a, info, root)
call mpi_gatherv(ltg,nlr,&
& psb_mpi_lpk_,l_t_g_all,all_dim,&
& displ,psb_mpi_lpk_,rootrank,icomm,info)
& displ,psb_mpi_lpk_,rootrank,icomm,minfo)
info = minfo
do col=1, k
! prepare vector to scatter
if(iam == iroot) then
@ -211,9 +212,9 @@ subroutine psb_i2scatterm(globx, locx, desc_a, info, root)
! scatter
call mpi_scatterv(scatterv,all_dim,displ,&
& psb_mpi_i2pk_,locx(1,col),nrow,&
& psb_mpi_i2pk_,rootrank,icomm,info)
& psb_mpi_i2pk_,locx(1,col),nlr,&
& psb_mpi_i2pk_,rootrank,icomm,minfo)
info = minfo
end do
deallocate(l_t_g_all, scatterv,stat=info)
@ -308,7 +309,7 @@ subroutine psb_i2scatterv(globx, locx, desc_a, info, root)
! locals
type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: np, iam, iroot, iiroot, icomm, myrank, rootrank, nlr
integer(psb_mpk_) :: np, iam, iroot, iiroot, icomm, myrank, rootrank, nlr, minfo
integer(psb_ipk_) :: ierr(5), err_act, nrow,&
& ilocx, jlocx, lda_locx, lda_globx, k, pos, ilx, jlx
integer(psb_lpk_) :: m, n, i, j, idx, iglobx, jglobx
@ -403,8 +404,8 @@ subroutine psb_i2scatterv(globx, locx, desc_a, info, root)
!
nlr = nrow
call mpi_gather(nlr,1,psb_mpi_mpk_,all_dim,&
& 1,psb_mpi_mpk_,rootrank,icomm,info)
& 1,psb_mpi_mpk_,rootrank,icomm,minfo)
info = minfo
if(iam == iroot) then
displ(1)=0
do i=2,np
@ -436,8 +437,8 @@ subroutine psb_i2scatterv(globx, locx, desc_a, info, root)
call mpi_gatherv(ltg,nlr,&
& psb_mpi_lpk_,l_t_g_all,all_dim,&
& displ,psb_mpi_lpk_,rootrank,icomm,info)
& displ,psb_mpi_lpk_,rootrank,icomm,minfo)
info = minfo
! prepare vector to scatter
if (iam == iroot) then
do i=1,np
@ -451,9 +452,9 @@ subroutine psb_i2scatterv(globx, locx, desc_a, info, root)
end if
call mpi_scatterv(scatterv,all_dim,displ,&
& psb_mpi_i2pk_,locx,nrow,&
& psb_mpi_i2pk_,rootrank,icomm,info)
& psb_mpi_i2pk_,locx,nlr,&
& psb_mpi_i2pk_,rootrank,icomm,minfo)
info = minfo
deallocate(l_t_g_all, scatterv,stat=info)
if(info /= psb_success_) then
info=psb_err_from_subroutine_

@ -66,8 +66,8 @@ subroutine psb_mhalom(x,desc_a,info,jx,ik,work,tran,mode,data)
! locals
type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: np, me
integer(psb_ipk_) :: err_act, iix, jjx, k, maxk, nrow, imode, i,&
integer(psb_mpk_) :: np, me, k
integer(psb_ipk_) :: err_act, iix, jjx, maxk, nrow, imode, i,&
& liwork,data_, ldx
integer(psb_lpk_) :: m, n, ix, ijx
integer(psb_mpk_),pointer :: iwork(:), xp(:,:)

@ -77,8 +77,8 @@ subroutine psb_movrlm(x,desc_a,info,jx,ik,work,update,mode)
! locals
type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: np, me
integer(psb_ipk_) :: err_act, iix, jjx, nrow, ncol, k, maxk, update_,&
integer(psb_mpk_) :: np, me, k
integer(psb_ipk_) :: err_act, iix, jjx, nrow, ncol, maxk, update_,&
& mode_, liwork, ldx
integer(psb_lpk_) :: m, n, ix, ijx
integer(psb_mpk_),pointer :: iwork(:), xp(:,:)

@ -63,7 +63,8 @@ subroutine psb_mscatterm(globx, locx, desc_a, info, root)
! locals
type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: np, me, iroot, icomm, myrank, rootrank, iam, nlr
integer(psb_mpk_) :: np, me, iroot, icomm, myrank, rootrank, iam,&
& nlr, minfo
integer(psb_ipk_) :: ierr(5), err_act, nrow,&
& ilocx, jlocx, lda_locx, lda_globx, lock, globk, k, maxk, &
& col,pos
@ -167,8 +168,8 @@ subroutine psb_mscatterm(globx, locx, desc_a, info, root)
!
nlr = nrow
call mpi_gather(nlr,1,psb_mpi_mpk_,all_dim,&
& 1,psb_mpi_mpk_,rootrank,icomm,info)
& 1,psb_mpi_mpk_,rootrank,icomm,minfo)
info = minfo
if (iam == iroot) then
displ(1)=0
do i=2,np
@ -195,8 +196,8 @@ subroutine psb_mscatterm(globx, locx, desc_a, info, root)
call mpi_gatherv(ltg,nlr,&
& psb_mpi_lpk_,l_t_g_all,all_dim,&
& displ,psb_mpi_lpk_,rootrank,icomm,info)
& displ,psb_mpi_lpk_,rootrank,icomm,minfo)
info = minfo
do col=1, k
! prepare vector to scatter
if(iam == iroot) then
@ -211,9 +212,9 @@ subroutine psb_mscatterm(globx, locx, desc_a, info, root)
! scatter
call mpi_scatterv(scatterv,all_dim,displ,&
& psb_mpi_mpk_,locx(1,col),nrow,&
& psb_mpi_mpk_,rootrank,icomm,info)
& psb_mpi_mpk_,locx(1,col),nlr,&
& psb_mpi_mpk_,rootrank,icomm,minfo)
info = minfo
end do
deallocate(l_t_g_all, scatterv,stat=info)
@ -308,7 +309,7 @@ subroutine psb_mscatterv(globx, locx, desc_a, info, root)
! locals
type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: np, iam, iroot, iiroot, icomm, myrank, rootrank, nlr
integer(psb_mpk_) :: np, iam, iroot, iiroot, icomm, myrank, rootrank, nlr, minfo
integer(psb_ipk_) :: ierr(5), err_act, nrow,&
& ilocx, jlocx, lda_locx, lda_globx, k, pos, ilx, jlx
integer(psb_lpk_) :: m, n, i, j, idx, iglobx, jglobx
@ -403,8 +404,8 @@ subroutine psb_mscatterv(globx, locx, desc_a, info, root)
!
nlr = nrow
call mpi_gather(nlr,1,psb_mpi_mpk_,all_dim,&
& 1,psb_mpi_mpk_,rootrank,icomm,info)
& 1,psb_mpi_mpk_,rootrank,icomm,minfo)
info = minfo
if(iam == iroot) then
displ(1)=0
do i=2,np
@ -436,8 +437,8 @@ subroutine psb_mscatterv(globx, locx, desc_a, info, root)
call mpi_gatherv(ltg,nlr,&
& psb_mpi_lpk_,l_t_g_all,all_dim,&
& displ,psb_mpi_lpk_,rootrank,icomm,info)
& displ,psb_mpi_lpk_,rootrank,icomm,minfo)
info = minfo
! prepare vector to scatter
if (iam == iroot) then
do i=1,np
@ -451,9 +452,9 @@ subroutine psb_mscatterv(globx, locx, desc_a, info, root)
end if
call mpi_scatterv(scatterv,all_dim,displ,&
& psb_mpi_mpk_,locx,nrow,&
& psb_mpi_mpk_,rootrank,icomm,info)
& psb_mpi_mpk_,locx,nlr,&
& psb_mpi_mpk_,rootrank,icomm,minfo)
info = minfo
deallocate(l_t_g_all, scatterv,stat=info)
if(info /= psb_success_) then
info=psb_err_from_subroutine_

@ -66,8 +66,8 @@ subroutine psb_shalom(x,desc_a,info,jx,ik,work,tran,mode,data)
! locals
type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: np, me
integer(psb_ipk_) :: err_act, iix, jjx, k, maxk, nrow, imode, i,&
integer(psb_mpk_) :: np, me, k
integer(psb_ipk_) :: err_act, iix, jjx, maxk, nrow, imode, i,&
& liwork,data_, ldx
integer(psb_lpk_) :: m, n, ix, ijx
real(psb_spk_),pointer :: iwork(:), xp(:,:)

@ -77,8 +77,8 @@ subroutine psb_sovrlm(x,desc_a,info,jx,ik,work,update,mode)
! locals
type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: np, me
integer(psb_ipk_) :: err_act, iix, jjx, nrow, ncol, k, maxk, update_,&
integer(psb_mpk_) :: np, me, k
integer(psb_ipk_) :: err_act, iix, jjx, nrow, ncol, maxk, update_,&
& mode_, liwork, ldx
integer(psb_lpk_) :: m, n, ix, ijx
real(psb_spk_),pointer :: iwork(:), xp(:,:)

@ -63,7 +63,8 @@ subroutine psb_sscatterm(globx, locx, desc_a, info, root)
! locals
type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: np, me, iroot, icomm, myrank, rootrank, iam, nlr
integer(psb_mpk_) :: np, me, iroot, icomm, myrank, rootrank, iam,&
& nlr, minfo
integer(psb_ipk_) :: ierr(5), err_act, nrow,&
& ilocx, jlocx, lda_locx, lda_globx, lock, globk, k, maxk, &
& col,pos
@ -167,8 +168,8 @@ subroutine psb_sscatterm(globx, locx, desc_a, info, root)
!
nlr = nrow
call mpi_gather(nlr,1,psb_mpi_mpk_,all_dim,&
& 1,psb_mpi_mpk_,rootrank,icomm,info)
& 1,psb_mpi_mpk_,rootrank,icomm,minfo)
info = minfo
if (iam == iroot) then
displ(1)=0
do i=2,np
@ -195,8 +196,8 @@ subroutine psb_sscatterm(globx, locx, desc_a, info, root)
call mpi_gatherv(ltg,nlr,&
& psb_mpi_lpk_,l_t_g_all,all_dim,&
& displ,psb_mpi_lpk_,rootrank,icomm,info)
& displ,psb_mpi_lpk_,rootrank,icomm,minfo)
info = minfo
do col=1, k
! prepare vector to scatter
if(iam == iroot) then
@ -211,9 +212,9 @@ subroutine psb_sscatterm(globx, locx, desc_a, info, root)
! scatter
call mpi_scatterv(scatterv,all_dim,displ,&
& psb_mpi_r_spk_,locx(1,col),nrow,&
& psb_mpi_r_spk_,rootrank,icomm,info)
& psb_mpi_r_spk_,locx(1,col),nlr,&
& psb_mpi_r_spk_,rootrank,icomm,minfo)
info = minfo
end do
deallocate(l_t_g_all, scatterv,stat=info)
@ -308,7 +309,7 @@ subroutine psb_sscatterv(globx, locx, desc_a, info, root)
! locals
type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: np, iam, iroot, iiroot, icomm, myrank, rootrank, nlr
integer(psb_mpk_) :: np, iam, iroot, iiroot, icomm, myrank, rootrank, nlr, minfo
integer(psb_ipk_) :: ierr(5), err_act, nrow,&
& ilocx, jlocx, lda_locx, lda_globx, k, pos, ilx, jlx
integer(psb_lpk_) :: m, n, i, j, idx, iglobx, jglobx
@ -403,8 +404,8 @@ subroutine psb_sscatterv(globx, locx, desc_a, info, root)
!
nlr = nrow
call mpi_gather(nlr,1,psb_mpi_mpk_,all_dim,&
& 1,psb_mpi_mpk_,rootrank,icomm,info)
& 1,psb_mpi_mpk_,rootrank,icomm,minfo)
info = minfo
if(iam == iroot) then
displ(1)=0
do i=2,np
@ -436,8 +437,8 @@ subroutine psb_sscatterv(globx, locx, desc_a, info, root)
call mpi_gatherv(ltg,nlr,&
& psb_mpi_lpk_,l_t_g_all,all_dim,&
& displ,psb_mpi_lpk_,rootrank,icomm,info)
& displ,psb_mpi_lpk_,rootrank,icomm,minfo)
info = minfo
! prepare vector to scatter
if (iam == iroot) then
do i=1,np
@ -451,9 +452,9 @@ subroutine psb_sscatterv(globx, locx, desc_a, info, root)
end if
call mpi_scatterv(scatterv,all_dim,displ,&
& psb_mpi_r_spk_,locx,nrow,&
& psb_mpi_r_spk_,rootrank,icomm,info)
& psb_mpi_r_spk_,locx,nlr,&
& psb_mpi_r_spk_,rootrank,icomm,minfo)
info = minfo
deallocate(l_t_g_all, scatterv,stat=info)
if(info /= psb_success_) then
info=psb_err_from_subroutine_

@ -66,8 +66,8 @@ subroutine psb_zhalom(x,desc_a,info,jx,ik,work,tran,mode,data)
! locals
type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: np, me
integer(psb_ipk_) :: err_act, iix, jjx, k, maxk, nrow, imode, i,&
integer(psb_mpk_) :: np, me, k
integer(psb_ipk_) :: err_act, iix, jjx, maxk, nrow, imode, i,&
& liwork,data_, ldx
integer(psb_lpk_) :: m, n, ix, ijx
complex(psb_dpk_),pointer :: iwork(:), xp(:,:)

@ -77,8 +77,8 @@ subroutine psb_zovrlm(x,desc_a,info,jx,ik,work,update,mode)
! locals
type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: np, me
integer(psb_ipk_) :: err_act, iix, jjx, nrow, ncol, k, maxk, update_,&
integer(psb_mpk_) :: np, me, k
integer(psb_ipk_) :: err_act, iix, jjx, nrow, ncol, maxk, update_,&
& mode_, liwork, ldx
integer(psb_lpk_) :: m, n, ix, ijx
complex(psb_dpk_),pointer :: iwork(:), xp(:,:)

@ -63,7 +63,8 @@ subroutine psb_zscatterm(globx, locx, desc_a, info, root)
! locals
type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: np, me, iroot, icomm, myrank, rootrank, iam, nlr
integer(psb_mpk_) :: np, me, iroot, icomm, myrank, rootrank, iam,&
& nlr, minfo
integer(psb_ipk_) :: ierr(5), err_act, nrow,&
& ilocx, jlocx, lda_locx, lda_globx, lock, globk, k, maxk, &
& col,pos
@ -167,8 +168,8 @@ subroutine psb_zscatterm(globx, locx, desc_a, info, root)
!
nlr = nrow
call mpi_gather(nlr,1,psb_mpi_mpk_,all_dim,&
& 1,psb_mpi_mpk_,rootrank,icomm,info)
& 1,psb_mpi_mpk_,rootrank,icomm,minfo)
info = minfo
if (iam == iroot) then
displ(1)=0
do i=2,np
@ -195,8 +196,8 @@ subroutine psb_zscatterm(globx, locx, desc_a, info, root)
call mpi_gatherv(ltg,nlr,&
& psb_mpi_lpk_,l_t_g_all,all_dim,&
& displ,psb_mpi_lpk_,rootrank,icomm,info)
& displ,psb_mpi_lpk_,rootrank,icomm,minfo)
info = minfo
do col=1, k
! prepare vector to scatter
if(iam == iroot) then
@ -211,9 +212,9 @@ subroutine psb_zscatterm(globx, locx, desc_a, info, root)
! scatter
call mpi_scatterv(scatterv,all_dim,displ,&
& psb_mpi_c_dpk_,locx(1,col),nrow,&
& psb_mpi_c_dpk_,rootrank,icomm,info)
& psb_mpi_c_dpk_,locx(1,col),nlr,&
& psb_mpi_c_dpk_,rootrank,icomm,minfo)
info = minfo
end do
deallocate(l_t_g_all, scatterv,stat=info)
@ -308,7 +309,7 @@ subroutine psb_zscatterv(globx, locx, desc_a, info, root)
! locals
type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: np, iam, iroot, iiroot, icomm, myrank, rootrank, nlr
integer(psb_mpk_) :: np, iam, iroot, iiroot, icomm, myrank, rootrank, nlr, minfo
integer(psb_ipk_) :: ierr(5), err_act, nrow,&
& ilocx, jlocx, lda_locx, lda_globx, k, pos, ilx, jlx
integer(psb_lpk_) :: m, n, i, j, idx, iglobx, jglobx
@ -403,8 +404,8 @@ subroutine psb_zscatterv(globx, locx, desc_a, info, root)
!
nlr = nrow
call mpi_gather(nlr,1,psb_mpi_mpk_,all_dim,&
& 1,psb_mpi_mpk_,rootrank,icomm,info)
& 1,psb_mpi_mpk_,rootrank,icomm,minfo)
info = minfo
if(iam == iroot) then
displ(1)=0
do i=2,np
@ -436,8 +437,8 @@ subroutine psb_zscatterv(globx, locx, desc_a, info, root)
call mpi_gatherv(ltg,nlr,&
& psb_mpi_lpk_,l_t_g_all,all_dim,&
& displ,psb_mpi_lpk_,rootrank,icomm,info)
& displ,psb_mpi_lpk_,rootrank,icomm,minfo)
info = minfo
! prepare vector to scatter
if (iam == iroot) then
do i=1,np
@ -451,9 +452,9 @@ subroutine psb_zscatterv(globx, locx, desc_a, info, root)
end if
call mpi_scatterv(scatterv,all_dim,displ,&
& psb_mpi_c_dpk_,locx,nrow,&
& psb_mpi_c_dpk_,rootrank,icomm,info)
& psb_mpi_c_dpk_,locx,nlr,&
& psb_mpi_c_dpk_,rootrank,icomm,minfo)
info = minfo
deallocate(l_t_g_all, scatterv,stat=info)
if(info /= psb_success_) then
info=psb_err_from_subroutine_

@ -81,12 +81,12 @@ subroutine psi_adjcncy_fnd_owner(idx,iprc,adj,idxmap,info)
integer(psb_mpk_), allocatable :: hsz(:),hidx(:), sdidx(:), rvidx(:),&
& sdsz(:), rvsz(:), sdhd(:), rvhd(:), p2pstat(:,:)
integer(psb_mpk_) :: prc, p2ptag, iret
integer(psb_mpk_) :: icomm, minfo
integer(psb_ipk_) :: i,n_row,n_col,err_act,hsize,ip,isz,j, k,&
& last_ih, last_j, nidx, nrecv, nadj
integer(psb_mpk_) :: icomm, minfo, ip,nidx
integer(psb_ipk_) :: n_row,n_col,err_act,hsize,isz,j, k,&
& last_ih, last_j, nrecv, nadj
integer(psb_lpk_) :: mglob, ih
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np,me
integer(psb_mpk_) :: np,me
logical, parameter :: debug=.false.
integer(psb_mpk_) :: xchg_alg
logical, parameter :: do_timings=.false.
@ -176,8 +176,8 @@ subroutine psi_adjcncy_fnd_owner(idx,iprc,adj,idxmap,info)
if (do_timings) call psb_toc(idx_phase11)
if (do_timings) call psb_tic(idx_phase12)
rvidx(0) = 0
do i=0, np-1
rvidx(i+1) = rvidx(i) + rvsz(i)
do ip=0, np-1
rvidx(ip+1) = rvidx(ip) + rvsz(ip)
end do
hsize = rvidx(np)
@ -204,9 +204,9 @@ subroutine psi_adjcncy_fnd_owner(idx,iprc,adj,idxmap,info)
! Third, compute local answers
!
call idxmap%g2l(rmtidx(1:hsize),lclidx(1:hsize),info,owned=.true.)
do i=1, hsize
tproc(i) = -1
if ((0 < lclidx(i)).and. (lclidx(i) <= n_row)) tproc(i) = me
do ip=1, hsize
tproc(ip) = -1
if ((0 < lclidx(ip)).and. (lclidx(ip) <= n_row)) tproc(ip) = me
end do
if (do_timings) call psb_toc(idx_phase2)
if (do_timings) call psb_tic(idx_phase3)
@ -215,8 +215,8 @@ subroutine psi_adjcncy_fnd_owner(idx,iprc,adj,idxmap,info)
! Fourth, exchange the answers
!
! Adjust sdidx for reuse in receiving lclidx array
do i=0,np-1
sdidx(i+1) = sdidx(i) + sdsz(i)
do ip=0,np-1
sdidx(ip+1) = sdidx(ip) + sdsz(ip)
end do
call mpi_alltoallv(tproc,rvsz,rvidx,psb_mpi_ipk_,&
& lclidx,sdsz,sdidx,psb_mpi_ipk_,icomm,iret)
@ -225,10 +225,10 @@ subroutine psi_adjcncy_fnd_owner(idx,iprc,adj,idxmap,info)
! Because IPRC has been initialized to -1, the MAX operation selects
! the answers.
!
do i=0, np-1
if (sdsz(i)>0) then
do ip=0, np-1
if (sdsz(ip)>0) then
! Must be nidx == sdsz(i)
iprc(1:nidx) = max(iprc(1:nidx), lclidx(sdidx(i)+1:sdidx(i)+sdsz(i)))
iprc(1:nidx) = max(iprc(1:nidx), lclidx(sdidx(ip)+1:sdidx(ip)+sdsz(ip)))
end if
end do
if (do_timings) call psb_toc(idx_phase3)
@ -262,8 +262,8 @@ subroutine psi_adjcncy_fnd_owner(idx,iprc,adj,idxmap,info)
call mpi_alltoall(sdsz,1,psb_mpi_mpk_,&
& rvsz,1,psb_mpi_mpk_,icomm,minfo)
hidx(0) = 0
do i=0, np-1
hidx(i+1) = hidx(i) + rvsz(i)
do ip=0, np-1
hidx(ip+1) = hidx(ip) + rvsz(ip)
end do
hsize = hidx(np)
! write(0,*)me,' Check on sizes from a2a:',hsize,rvsz(:)
@ -276,22 +276,23 @@ subroutine psi_adjcncy_fnd_owner(idx,iprc,adj,idxmap,info)
call psb_errpush(psb_err_from_subroutine_,name,a_err='Allocate')
goto 9999
end if
do i = 0, np-1
if (rvsz(i)>0) then
do ip = 0, np-1
if (rvsz(ip)>0) then
! write(0,*) me, ' First receive from ',i,rvsz(i)
prc = psb_get_mpi_rank(ctxt,i)
prc = psb_get_mpi_rank(ctxt,ip)
p2ptag = psb_long_swap_tag
!write(0,*) me, ' Posting first receive from ',i,rvsz(i),prc
call mpi_irecv(rmtidx(hidx(i)+1),rvsz(i),&
call mpi_irecv(rmtidx(hidx(ip)+1),rvsz(ip),&
& psb_mpi_lpk_,prc,&
& p2ptag, icomm,rvhd(i),iret)
& p2ptag, icomm,rvhd(ip),iret)
end if
end do
if (do_timings) call psb_toc(idx_phase11)
if (do_timings) call psb_tic(idx_phase12)
do j=1, nadj
if (nidx > 0) then
prc = psb_get_mpi_rank(ctxt,adj(j))
ip = adj(j)
prc = psb_get_mpi_rank(ctxt,ip)
p2ptag = psb_long_swap_tag
!write(0,*) me, ' First send to ',adj(j),nidx, prc
call mpi_send(idx,nidx,&
@ -310,9 +311,9 @@ subroutine psi_adjcncy_fnd_owner(idx,iprc,adj,idxmap,info)
! Third, compute local answers
!
call idxmap%g2l(rmtidx(1:hsize),lclidx(1:hsize),info,owned=.true.)
do i=1, hsize
tproc(i) = -1
if ((0 < lclidx(i)).and. (lclidx(i) <= n_row)) tproc(i) = me
do ip=1, hsize
tproc(ip) = -1
if ((0 < lclidx(ip)).and. (lclidx(ip) <= n_row)) tproc(ip) = me
end do
if (do_timings) call psb_toc(idx_phase2)
if (do_timings) call psb_tic(idx_phase3)
@ -323,7 +324,8 @@ subroutine psi_adjcncy_fnd_owner(idx,iprc,adj,idxmap,info)
do j=1, nadj
!write(0,*) me, ' First send to ',adj(j),nidx
if (nidx > 0) then
prc = psb_get_mpi_rank(ctxt,adj(j))
ip = adj(j)
prc = psb_get_mpi_rank(ctxt,ip)
p2ptag = psb_int_swap_tag
!write(0,*) me, ' Posting second receive from ',adj(j),nidx, prc
call mpi_irecv(lclidx((j-1)*nidx+1),nidx, &
@ -335,12 +337,12 @@ subroutine psi_adjcncy_fnd_owner(idx,iprc,adj,idxmap,info)
!
! Fourth, send data back;
!
do i = 0, np-1
if (rvsz(i)>0) then
prc = psb_get_mpi_rank(ctxt,i)
do ip = 0, np-1
if (rvsz(ip)>0) then
prc = psb_get_mpi_rank(ctxt,ip)
p2ptag = psb_int_swap_tag
!write(0,*) me, ' Second send to ',i,rvsz(i), prc
call mpi_send(tproc(hidx(i)+1),rvsz(i),&
call mpi_send(tproc(hidx(ip)+1),rvsz(ip),&
& psb_mpi_ipk_,prc,&
& p2ptag, icomm,iret)
end if
@ -372,8 +374,8 @@ subroutine psi_adjcncy_fnd_owner(idx,iprc,adj,idxmap,info)
call mpi_alltoall(sdsz,1,psb_mpi_mpk_,&
& rvsz,1,psb_mpi_mpk_,icomm,minfo)
hidx(0) = 0
do i=0, np-1
hidx(i+1) = hidx(i) + rvsz(i)
do ip=0, np-1
hidx(ip+1) = hidx(ip) + rvsz(ip)
end do
hsize = hidx(np)
! write(0,*)me,' Check on sizes from a2a:',hsize,rvsz(:)
@ -388,12 +390,13 @@ subroutine psi_adjcncy_fnd_owner(idx,iprc,adj,idxmap,info)
end if
do j=1, nadj
!write(0,*) me, ' First send to ',adj(j),nidx
if (nidx > 0) call psb_snd(ctxt,idx(1:nidx),adj(j))
ip = adj(j)
if (nidx > 0) call psb_snd(ctxt,idx(1:nidx),ip)
end do
do i = 0, np-1
if (rvsz(i)>0) then
do ip = 0, np-1
if (rvsz(ip)>0) then
! write(0,*) me, ' First receive from ',i,rvsz(i)
call psb_rcv(ctxt,rmtidx(hidx(i)+1:hidx(i)+rvsz(i)),i)
call psb_rcv(ctxt,rmtidx(hidx(ip)+1:hidx(ip)+rvsz(ip)),ip)
end if
end do
@ -401,18 +404,18 @@ subroutine psi_adjcncy_fnd_owner(idx,iprc,adj,idxmap,info)
! Third, compute local answers
!
call idxmap%g2l(rmtidx(1:hsize),lclidx(1:hsize),info,owned=.true.)
do i=1, hsize
tproc(i) = -1
if ((0 < lclidx(i)).and. (lclidx(i) <= n_row)) tproc(i) = me
do ip=1, hsize
tproc(ip) = -1
if ((0 < lclidx(ip)).and. (lclidx(ip) <= n_row)) tproc(ip) = me
end do
!
! Fourth, send data back;
!
do i = 0, np-1
if (rvsz(i)>0) then
do ip = 0, np-1
if (rvsz(ip)>0) then
!write(0,*) me, ' Second send to ',i,rvsz(i)
call psb_snd(ctxt,tproc(hidx(i)+1:hidx(i)+rvsz(i)),i)
call psb_snd(ctxt,tproc(hidx(ip)+1:hidx(ip)+rvsz(ip)),ip)
end if
end do
!
@ -420,8 +423,9 @@ subroutine psi_adjcncy_fnd_owner(idx,iprc,adj,idxmap,info)
! answer is -1. Reuse tproc
!
do j = 1, nadj
!write(0,*) me, ' Second receive from ',adj(j), nidx
if (nidx > 0) call psb_rcv(ctxt,tproc(1:nidx),adj(j))
!write(0,*) me, ' Second receive from ',adj(j), nidx
ip = adj(j)
if (nidx > 0) call psb_rcv(ctxt,tproc(1:nidx),ip)
iprc(1:nidx) = max(iprc(1:nidx), tproc(1:nidx))
end do
case default

@ -45,8 +45,10 @@ subroutine psi_i_bld_glb_dep_list(ctxt,loc_dl,length_dl,c_dep_list,dl_ptr,info)
#endif
! ....scalar parameters...
type(psb_ctxt_type), intent(in) :: ctxt
integer(psb_ipk_), intent(in) :: loc_dl(:), length_dl(0:)
integer(psb_ipk_), allocatable, intent(out) :: c_dep_list(:), dl_ptr(:)
integer(psb_ipk_), intent(in) :: loc_dl(:)
integer(psb_mpk_), intent(in) :: length_dl(0:)
integer(psb_mpk_), allocatable, intent(out) :: dl_ptr(:)
integer(psb_ipk_), allocatable, intent(out) :: c_dep_list(:)
integer(psb_ipk_), intent(out) :: info
@ -54,10 +56,11 @@ subroutine psi_i_bld_glb_dep_list(ctxt,loc_dl,length_dl,c_dep_list,dl_ptr,info)
integer(psb_ipk_) :: int_err(5)
! .....local scalars...
integer(psb_ipk_) :: i, proc,j,err_act, length, myld
integer(psb_mpk_) :: myld
integer(psb_ipk_) :: i, proc,j,err_act, length
integer(psb_ipk_) :: err
integer(psb_ipk_) :: debug_level, debug_unit
integer(psb_ipk_) :: me, np
integer(psb_mpk_) :: me, np
integer(psb_mpk_) :: icomm, minfo
logical, parameter :: dist_symm_list=.false., print_dl=.false.
character name*20

@ -67,8 +67,8 @@ subroutine psi_i_crea_index(desc_a,index_in,index_out,nxch,nsnd,nrcv,info)
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: me, np, mode, err_act, dl_lda, ldl
! ...parameters...
integer(psb_ipk_), allocatable :: length_dl(:), loc_dl(:),&
& c_dep_list(:), dl_ptr(:)
integer(psb_mpk_), allocatable :: length_dl(:), dl_ptr(:)
integer(psb_ipk_), allocatable :: loc_dl(:), c_dep_list(:)
integer(psb_ipk_) :: dlmax, dlavg
integer(psb_ipk_),parameter :: root=psb_root_,no_comm=-1
integer(psb_ipk_) :: debug_level, debug_unit
@ -132,7 +132,7 @@ subroutine psi_i_crea_index(desc_a,index_in,index_out,nxch,nsnd,nrcv,info)
if (do_timings) call psb_toc(idx_phase21)
if (do_timings) call psb_tic(idx_phase22)
call psi_sort_dl(dl_ptr,c_dep_list,length_dl,ctxt,info)
call psi_i_csr_sort_dl(dl_ptr,c_dep_list,length_dl,ctxt,info)
if (info /= 0) then
write(0,*) me,trim(name),' From sort_dl ',info
end if

@ -119,7 +119,8 @@ subroutine psi_i_desc_index(desc,index_in,dep_list,&
integer(psb_ipk_),allocatable :: desc_index(:)
integer(psb_ipk_) :: length_dl,nsnd,nrcv,info
! ....local scalars...
integer(psb_ipk_) :: j,me,np,i,proc
integer(psb_mpk_) :: me,np,proc
integer(psb_ipk_) :: j,i
! ...parameters...
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_), parameter :: no_comm=-1

@ -237,7 +237,7 @@ subroutine psi_graph_fnd_owner(idx,iprc,ladj,idxmap,info)
! Choose a sample, should it be done in this simplistic way?
! Note: nsampl_in is a hint, not an absolute, hence nsampl_out
!
call psi_get_sample(1,idx,iprc,tidx,tsmpl,iend,nsampl_in,nsampl_out)
call psi_get_sample(ione,idx,iprc,tidx,tsmpl,iend,nsampl_in,nsampl_out)
nsampl = min(nsampl_out,nsampl_in)
if (debugsz) write(0,*) me,' From first sampling ',nsampl_in
!

@ -84,8 +84,8 @@ subroutine psi_i_csr_sort_dl(dl_ptr,c_dep_list,l_dep_list,ctxt,info)
use psb_sort_mod
implicit none
integer(psb_ipk_), intent(in) :: dl_ptr(0:)
integer(psb_ipk_), intent(inout) :: c_dep_list(:), l_dep_list(0:)
integer(psb_mpk_), intent(in) :: dl_ptr(0:), l_dep_list(0:)
integer(psb_ipk_), intent(inout) :: c_dep_list(:)
type(psb_ctxt_type), intent(in) :: ctxt
integer(psb_ipk_), intent(out) :: info
! Local variables

@ -125,7 +125,8 @@ subroutine psi_i_xtr_loc_dl(ctxt,is_bld,is_upd,desc_str,loc_dl,length_dl,info)
logical, intent(in) :: is_bld, is_upd
type(psb_ctxt_type), intent(in) :: ctxt
integer(psb_ipk_), intent(in) :: desc_str(:)
integer(psb_ipk_), allocatable, intent(out) :: loc_dl(:), length_dl(:)
integer(psb_ipk_), allocatable, intent(out) :: loc_dl(:)
integer(psb_mpk_), allocatable, intent(out) :: length_dl(:)
integer(psb_ipk_), intent(out) :: info
! .....local arrays....
integer(psb_ipk_) :: int_err(5)

@ -324,7 +324,7 @@ desc/psb_hash_map_mod.o desc/psb_list_map_mod.o desc/psb_repl_map_mod.o desc/psb
desc/psb_indx_map_mod.o desc/psb_desc_const_mod.o \
auxil/psb_sort_mod.o psb_penv_mod.o
desc/psb_glist_map_mod.o: desc/psb_list_map_mod.o
desc/psb_hash_map_mod.o: desc/psb_hash_mod.o auxil/psb_sort_mod.o
desc/psb_hash_map_mod.o: desc/psb_hash_mod.o auxil/psb_sort_mod.o psb_timers_mod.o
desc/psb_gen_block_map_mod.o: desc/psb_hash_mod.o
desc/psb_hash_mod.o: psb_cbind_const_mod.o
psb_cbind_const_mod.o: psb_const_mod.o

@ -128,64 +128,72 @@ module psi_c_serial_mod
interface psi_gth
subroutine psi_cgthmv(n,k,idx,alpha,x,beta,y)
import :: psb_ipk_, psb_spk_
import :: psb_ipk_, psb_mpk_, psb_spk_
implicit none
integer(psb_ipk_) :: n, k, idx(:)
integer(psb_mpk_) :: n, k
integer(psb_ipk_) :: idx(:)
complex(psb_spk_) :: x(:,:), y(:),alpha,beta
end subroutine psi_cgthmv
subroutine psi_cgthv(n,idx,alpha,x,beta,y)
import :: psb_ipk_, psb_spk_
import :: psb_ipk_, psb_mpk_, psb_spk_
implicit none
integer(psb_ipk_) :: n, idx(:)
integer(psb_mpk_) :: n
integer(psb_ipk_) :: idx(:)
complex(psb_spk_) :: x(:), y(:),alpha,beta
end subroutine psi_cgthv
subroutine psi_cgthzmv(n,k,idx,x,y)
import :: psb_ipk_, psb_spk_
import :: psb_ipk_, psb_mpk_, psb_spk_
implicit none
integer(psb_ipk_) :: n, k, idx(:)
integer(psb_mpk_) :: n, k
integer(psb_ipk_) :: idx(:)
complex(psb_spk_) :: x(:,:), y(:)
end subroutine psi_cgthzmv
subroutine psi_cgthzmm(n,k,idx,x,y)
import :: psb_ipk_, psb_spk_
import :: psb_ipk_, psb_mpk_, psb_spk_
implicit none
integer(psb_ipk_) :: n, k, idx(:)
integer(psb_mpk_) :: n, k
integer(psb_ipk_) :: idx(:)
complex(psb_spk_) :: x(:,:), y(:,:)
end subroutine psi_cgthzmm
subroutine psi_cgthzv(n,idx,x,y)
import :: psb_ipk_, psb_spk_
import :: psb_ipk_, psb_mpk_, psb_spk_
implicit none
integer(psb_ipk_) :: n, idx(:)
integer(psb_mpk_) :: n
integer(psb_ipk_) :: idx(:)
complex(psb_spk_) :: x(:), y(:)
end subroutine psi_cgthzv
end interface psi_gth
interface psi_sct
subroutine psi_csctmm(n,k,idx,x,beta,y)
import :: psb_ipk_, psb_spk_
import :: psb_ipk_, psb_mpk_, psb_spk_
implicit none
integer(psb_ipk_) :: n, k, idx(:)
integer(psb_mpk_) :: n, k
integer(psb_ipk_) :: idx(:)
complex(psb_spk_) :: beta, x(:,:), y(:,:)
end subroutine psi_csctmm
subroutine psi_csctmv(n,k,idx,x,beta,y)
import :: psb_ipk_, psb_spk_
import :: psb_ipk_, psb_mpk_, psb_spk_
implicit none
integer(psb_ipk_) :: n, k, idx(:)
integer(psb_mpk_) :: n, k
integer(psb_ipk_) :: idx(:)
complex(psb_spk_) :: beta, x(:), y(:,:)
end subroutine psi_csctmv
subroutine psi_csctv(n,idx,x,beta,y)
import :: psb_ipk_, psb_spk_
import :: psb_ipk_, psb_mpk_, psb_spk_
implicit none
integer(psb_ipk_) :: n, idx(:)
integer(psb_mpk_) :: n
integer(psb_ipk_) :: idx(:)
complex(psb_spk_) :: beta, x(:), y(:)
end subroutine psi_csctv
end interface psi_sct
interface psi_exscan
subroutine psi_c_exscanv(n,x,info,shift)
import :: psb_ipk_, psb_spk_
import :: psb_ipk_, psb_mpk_, psb_spk_
implicit none
integer(psb_ipk_), intent(in) :: n
complex(psb_spk_), intent (inout) :: x(:)

@ -128,64 +128,72 @@ module psi_d_serial_mod
interface psi_gth
subroutine psi_dgthmv(n,k,idx,alpha,x,beta,y)
import :: psb_ipk_, psb_dpk_
import :: psb_ipk_, psb_mpk_, psb_dpk_
implicit none
integer(psb_ipk_) :: n, k, idx(:)
integer(psb_mpk_) :: n, k
integer(psb_ipk_) :: idx(:)
real(psb_dpk_) :: x(:,:), y(:),alpha,beta
end subroutine psi_dgthmv
subroutine psi_dgthv(n,idx,alpha,x,beta,y)
import :: psb_ipk_, psb_dpk_
import :: psb_ipk_, psb_mpk_, psb_dpk_
implicit none
integer(psb_ipk_) :: n, idx(:)
integer(psb_mpk_) :: n
integer(psb_ipk_) :: idx(:)
real(psb_dpk_) :: x(:), y(:),alpha,beta
end subroutine psi_dgthv
subroutine psi_dgthzmv(n,k,idx,x,y)
import :: psb_ipk_, psb_dpk_
import :: psb_ipk_, psb_mpk_, psb_dpk_
implicit none
integer(psb_ipk_) :: n, k, idx(:)
integer(psb_mpk_) :: n, k
integer(psb_ipk_) :: idx(:)
real(psb_dpk_) :: x(:,:), y(:)
end subroutine psi_dgthzmv
subroutine psi_dgthzmm(n,k,idx,x,y)
import :: psb_ipk_, psb_dpk_
import :: psb_ipk_, psb_mpk_, psb_dpk_
implicit none
integer(psb_ipk_) :: n, k, idx(:)
integer(psb_mpk_) :: n, k
integer(psb_ipk_) :: idx(:)
real(psb_dpk_) :: x(:,:), y(:,:)
end subroutine psi_dgthzmm
subroutine psi_dgthzv(n,idx,x,y)
import :: psb_ipk_, psb_dpk_
import :: psb_ipk_, psb_mpk_, psb_dpk_
implicit none
integer(psb_ipk_) :: n, idx(:)
integer(psb_mpk_) :: n
integer(psb_ipk_) :: idx(:)
real(psb_dpk_) :: x(:), y(:)
end subroutine psi_dgthzv
end interface psi_gth
interface psi_sct
subroutine psi_dsctmm(n,k,idx,x,beta,y)
import :: psb_ipk_, psb_dpk_
import :: psb_ipk_, psb_mpk_, psb_dpk_
implicit none
integer(psb_ipk_) :: n, k, idx(:)
integer(psb_mpk_) :: n, k
integer(psb_ipk_) :: idx(:)
real(psb_dpk_) :: beta, x(:,:), y(:,:)
end subroutine psi_dsctmm
subroutine psi_dsctmv(n,k,idx,x,beta,y)
import :: psb_ipk_, psb_dpk_
import :: psb_ipk_, psb_mpk_, psb_dpk_
implicit none
integer(psb_ipk_) :: n, k, idx(:)
integer(psb_mpk_) :: n, k
integer(psb_ipk_) :: idx(:)
real(psb_dpk_) :: beta, x(:), y(:,:)
end subroutine psi_dsctmv
subroutine psi_dsctv(n,idx,x,beta,y)
import :: psb_ipk_, psb_dpk_
import :: psb_ipk_, psb_mpk_, psb_dpk_
implicit none
integer(psb_ipk_) :: n, idx(:)
integer(psb_mpk_) :: n
integer(psb_ipk_) :: idx(:)
real(psb_dpk_) :: beta, x(:), y(:)
end subroutine psi_dsctv
end interface psi_sct
interface psi_exscan
subroutine psi_d_exscanv(n,x,info,shift)
import :: psb_ipk_, psb_dpk_
import :: psb_ipk_, psb_mpk_, psb_dpk_
implicit none
integer(psb_ipk_), intent(in) :: n
real(psb_dpk_), intent (inout) :: x(:)

@ -130,33 +130,38 @@ module psi_e_serial_mod
subroutine psi_egthmv(n,k,idx,alpha,x,beta,y)
import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_
implicit none
integer(psb_ipk_) :: n, k, idx(:)
integer(psb_mpk_) :: n, k
integer(psb_ipk_) :: idx(:)
integer(psb_epk_) :: x(:,:), y(:),alpha,beta
end subroutine psi_egthmv
subroutine psi_egthv(n,idx,alpha,x,beta,y)
import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_
implicit none
integer(psb_ipk_) :: n, idx(:)
integer(psb_mpk_) :: n
integer(psb_ipk_) :: idx(:)
integer(psb_epk_) :: x(:), y(:),alpha,beta
end subroutine psi_egthv
subroutine psi_egthzmv(n,k,idx,x,y)
import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_
implicit none
integer(psb_ipk_) :: n, k, idx(:)
integer(psb_mpk_) :: n, k
integer(psb_ipk_) :: idx(:)
integer(psb_epk_) :: x(:,:), y(:)
end subroutine psi_egthzmv
subroutine psi_egthzmm(n,k,idx,x,y)
import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_
implicit none
integer(psb_ipk_) :: n, k, idx(:)
integer(psb_mpk_) :: n, k
integer(psb_ipk_) :: idx(:)
integer(psb_epk_) :: x(:,:), y(:,:)
end subroutine psi_egthzmm
subroutine psi_egthzv(n,idx,x,y)
import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_
implicit none
integer(psb_ipk_) :: n, idx(:)
integer(psb_mpk_) :: n
integer(psb_ipk_) :: idx(:)
integer(psb_epk_) :: x(:), y(:)
end subroutine psi_egthzv
end interface psi_gth
@ -165,20 +170,23 @@ module psi_e_serial_mod
subroutine psi_esctmm(n,k,idx,x,beta,y)
import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_
implicit none
integer(psb_ipk_) :: n, k, idx(:)
integer(psb_mpk_) :: n, k
integer(psb_ipk_) :: idx(:)
integer(psb_epk_) :: beta, x(:,:), y(:,:)
end subroutine psi_esctmm
subroutine psi_esctmv(n,k,idx,x,beta,y)
import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_
implicit none
integer(psb_ipk_) :: n, k, idx(:)
integer(psb_mpk_) :: n, k
integer(psb_ipk_) :: idx(:)
integer(psb_epk_) :: beta, x(:), y(:,:)
end subroutine psi_esctmv
subroutine psi_esctv(n,idx,x,beta,y)
import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_
implicit none
integer(psb_ipk_) :: n, idx(:)
integer(psb_mpk_) :: n
integer(psb_ipk_) :: idx(:)
integer(psb_epk_) :: beta, x(:), y(:)
end subroutine psi_esctv
end interface psi_sct

@ -130,33 +130,38 @@ module psi_i2_serial_mod
subroutine psi_i2gthmv(n,k,idx,alpha,x,beta,y)
import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_
implicit none
integer(psb_ipk_) :: n, k, idx(:)
integer(psb_mpk_) :: n, k
integer(psb_ipk_) :: idx(:)
integer(psb_i2pk_) :: x(:,:), y(:),alpha,beta
end subroutine psi_i2gthmv
subroutine psi_i2gthv(n,idx,alpha,x,beta,y)
import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_
implicit none
integer(psb_ipk_) :: n, idx(:)
integer(psb_mpk_) :: n
integer(psb_ipk_) :: idx(:)
integer(psb_i2pk_) :: x(:), y(:),alpha,beta
end subroutine psi_i2gthv
subroutine psi_i2gthzmv(n,k,idx,x,y)
import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_
implicit none
integer(psb_ipk_) :: n, k, idx(:)
integer(psb_mpk_) :: n, k
integer(psb_ipk_) :: idx(:)
integer(psb_i2pk_) :: x(:,:), y(:)
end subroutine psi_i2gthzmv
subroutine psi_i2gthzmm(n,k,idx,x,y)
import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_
implicit none
integer(psb_ipk_) :: n, k, idx(:)
integer(psb_mpk_) :: n, k
integer(psb_ipk_) :: idx(:)
integer(psb_i2pk_) :: x(:,:), y(:,:)
end subroutine psi_i2gthzmm
subroutine psi_i2gthzv(n,idx,x,y)
import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_
implicit none
integer(psb_ipk_) :: n, idx(:)
integer(psb_mpk_) :: n
integer(psb_ipk_) :: idx(:)
integer(psb_i2pk_) :: x(:), y(:)
end subroutine psi_i2gthzv
end interface psi_gth
@ -165,20 +170,23 @@ module psi_i2_serial_mod
subroutine psi_i2sctmm(n,k,idx,x,beta,y)
import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_
implicit none
integer(psb_ipk_) :: n, k, idx(:)
integer(psb_mpk_) :: n, k
integer(psb_ipk_) :: idx(:)
integer(psb_i2pk_) :: beta, x(:,:), y(:,:)
end subroutine psi_i2sctmm
subroutine psi_i2sctmv(n,k,idx,x,beta,y)
import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_
implicit none
integer(psb_ipk_) :: n, k, idx(:)
integer(psb_mpk_) :: n, k
integer(psb_ipk_) :: idx(:)
integer(psb_i2pk_) :: beta, x(:), y(:,:)
end subroutine psi_i2sctmv
subroutine psi_i2sctv(n,idx,x,beta,y)
import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_
implicit none
integer(psb_ipk_) :: n, idx(:)
integer(psb_mpk_) :: n
integer(psb_ipk_) :: idx(:)
integer(psb_i2pk_) :: beta, x(:), y(:)
end subroutine psi_i2sctv
end interface psi_sct

@ -130,33 +130,38 @@ module psi_m_serial_mod
subroutine psi_mgthmv(n,k,idx,alpha,x,beta,y)
import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_
implicit none
integer(psb_ipk_) :: n, k, idx(:)
integer(psb_mpk_) :: n, k
integer(psb_ipk_) :: idx(:)
integer(psb_mpk_) :: x(:,:), y(:),alpha,beta
end subroutine psi_mgthmv
subroutine psi_mgthv(n,idx,alpha,x,beta,y)
import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_
implicit none
integer(psb_ipk_) :: n, idx(:)
integer(psb_mpk_) :: n
integer(psb_ipk_) :: idx(:)
integer(psb_mpk_) :: x(:), y(:),alpha,beta
end subroutine psi_mgthv
subroutine psi_mgthzmv(n,k,idx,x,y)
import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_
implicit none
integer(psb_ipk_) :: n, k, idx(:)
integer(psb_mpk_) :: n, k
integer(psb_ipk_) :: idx(:)
integer(psb_mpk_) :: x(:,:), y(:)
end subroutine psi_mgthzmv
subroutine psi_mgthzmm(n,k,idx,x,y)
import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_
implicit none
integer(psb_ipk_) :: n, k, idx(:)
integer(psb_mpk_) :: n, k
integer(psb_ipk_) :: idx(:)
integer(psb_mpk_) :: x(:,:), y(:,:)
end subroutine psi_mgthzmm
subroutine psi_mgthzv(n,idx,x,y)
import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_
implicit none
integer(psb_ipk_) :: n, idx(:)
integer(psb_mpk_) :: n
integer(psb_ipk_) :: idx(:)
integer(psb_mpk_) :: x(:), y(:)
end subroutine psi_mgthzv
end interface psi_gth
@ -165,20 +170,23 @@ module psi_m_serial_mod
subroutine psi_msctmm(n,k,idx,x,beta,y)
import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_
implicit none
integer(psb_ipk_) :: n, k, idx(:)
integer(psb_mpk_) :: n, k
integer(psb_ipk_) :: idx(:)
integer(psb_mpk_) :: beta, x(:,:), y(:,:)
end subroutine psi_msctmm
subroutine psi_msctmv(n,k,idx,x,beta,y)
import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_
implicit none
integer(psb_ipk_) :: n, k, idx(:)
integer(psb_mpk_) :: n, k
integer(psb_ipk_) :: idx(:)
integer(psb_mpk_) :: beta, x(:), y(:,:)
end subroutine psi_msctmv
subroutine psi_msctv(n,idx,x,beta,y)
import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_
implicit none
integer(psb_ipk_) :: n, idx(:)
integer(psb_mpk_) :: n
integer(psb_ipk_) :: idx(:)
integer(psb_mpk_) :: beta, x(:), y(:)
end subroutine psi_msctv
end interface psi_sct

@ -128,64 +128,72 @@ module psi_s_serial_mod
interface psi_gth
subroutine psi_sgthmv(n,k,idx,alpha,x,beta,y)
import :: psb_ipk_, psb_spk_
import :: psb_ipk_, psb_mpk_, psb_spk_
implicit none
integer(psb_ipk_) :: n, k, idx(:)
integer(psb_mpk_) :: n, k
integer(psb_ipk_) :: idx(:)
real(psb_spk_) :: x(:,:), y(:),alpha,beta
end subroutine psi_sgthmv
subroutine psi_sgthv(n,idx,alpha,x,beta,y)
import :: psb_ipk_, psb_spk_
import :: psb_ipk_, psb_mpk_, psb_spk_
implicit none
integer(psb_ipk_) :: n, idx(:)
integer(psb_mpk_) :: n
integer(psb_ipk_) :: idx(:)
real(psb_spk_) :: x(:), y(:),alpha,beta
end subroutine psi_sgthv
subroutine psi_sgthzmv(n,k,idx,x,y)
import :: psb_ipk_, psb_spk_
import :: psb_ipk_, psb_mpk_, psb_spk_
implicit none
integer(psb_ipk_) :: n, k, idx(:)
integer(psb_mpk_) :: n, k
integer(psb_ipk_) :: idx(:)
real(psb_spk_) :: x(:,:), y(:)
end subroutine psi_sgthzmv
subroutine psi_sgthzmm(n,k,idx,x,y)
import :: psb_ipk_, psb_spk_
import :: psb_ipk_, psb_mpk_, psb_spk_
implicit none
integer(psb_ipk_) :: n, k, idx(:)
integer(psb_mpk_) :: n, k
integer(psb_ipk_) :: idx(:)
real(psb_spk_) :: x(:,:), y(:,:)
end subroutine psi_sgthzmm
subroutine psi_sgthzv(n,idx,x,y)
import :: psb_ipk_, psb_spk_
import :: psb_ipk_, psb_mpk_, psb_spk_
implicit none
integer(psb_ipk_) :: n, idx(:)
integer(psb_mpk_) :: n
integer(psb_ipk_) :: idx(:)
real(psb_spk_) :: x(:), y(:)
end subroutine psi_sgthzv
end interface psi_gth
interface psi_sct
subroutine psi_ssctmm(n,k,idx,x,beta,y)
import :: psb_ipk_, psb_spk_
import :: psb_ipk_, psb_mpk_, psb_spk_
implicit none
integer(psb_ipk_) :: n, k, idx(:)
integer(psb_mpk_) :: n, k
integer(psb_ipk_) :: idx(:)
real(psb_spk_) :: beta, x(:,:), y(:,:)
end subroutine psi_ssctmm
subroutine psi_ssctmv(n,k,idx,x,beta,y)
import :: psb_ipk_, psb_spk_
import :: psb_ipk_, psb_mpk_, psb_spk_
implicit none
integer(psb_ipk_) :: n, k, idx(:)
integer(psb_mpk_) :: n, k
integer(psb_ipk_) :: idx(:)
real(psb_spk_) :: beta, x(:), y(:,:)
end subroutine psi_ssctmv
subroutine psi_ssctv(n,idx,x,beta,y)
import :: psb_ipk_, psb_spk_
import :: psb_ipk_, psb_mpk_, psb_spk_
implicit none
integer(psb_ipk_) :: n, idx(:)
integer(psb_mpk_) :: n
integer(psb_ipk_) :: idx(:)
real(psb_spk_) :: beta, x(:), y(:)
end subroutine psi_ssctv
end interface psi_sct
interface psi_exscan
subroutine psi_s_exscanv(n,x,info,shift)
import :: psb_ipk_, psb_spk_
import :: psb_ipk_, psb_mpk_, psb_spk_
implicit none
integer(psb_ipk_), intent(in) :: n
real(psb_spk_), intent (inout) :: x(:)

@ -128,64 +128,72 @@ module psi_z_serial_mod
interface psi_gth
subroutine psi_zgthmv(n,k,idx,alpha,x,beta,y)
import :: psb_ipk_, psb_dpk_
import :: psb_ipk_, psb_mpk_, psb_dpk_
implicit none
integer(psb_ipk_) :: n, k, idx(:)
integer(psb_mpk_) :: n, k
integer(psb_ipk_) :: idx(:)
complex(psb_dpk_) :: x(:,:), y(:),alpha,beta
end subroutine psi_zgthmv
subroutine psi_zgthv(n,idx,alpha,x,beta,y)
import :: psb_ipk_, psb_dpk_
import :: psb_ipk_, psb_mpk_, psb_dpk_
implicit none
integer(psb_ipk_) :: n, idx(:)
integer(psb_mpk_) :: n
integer(psb_ipk_) :: idx(:)
complex(psb_dpk_) :: x(:), y(:),alpha,beta
end subroutine psi_zgthv
subroutine psi_zgthzmv(n,k,idx,x,y)
import :: psb_ipk_, psb_dpk_
import :: psb_ipk_, psb_mpk_, psb_dpk_
implicit none
integer(psb_ipk_) :: n, k, idx(:)
integer(psb_mpk_) :: n, k
integer(psb_ipk_) :: idx(:)
complex(psb_dpk_) :: x(:,:), y(:)
end subroutine psi_zgthzmv
subroutine psi_zgthzmm(n,k,idx,x,y)
import :: psb_ipk_, psb_dpk_
import :: psb_ipk_, psb_mpk_, psb_dpk_
implicit none
integer(psb_ipk_) :: n, k, idx(:)
integer(psb_mpk_) :: n, k
integer(psb_ipk_) :: idx(:)
complex(psb_dpk_) :: x(:,:), y(:,:)
end subroutine psi_zgthzmm
subroutine psi_zgthzv(n,idx,x,y)
import :: psb_ipk_, psb_dpk_
import :: psb_ipk_, psb_mpk_, psb_dpk_
implicit none
integer(psb_ipk_) :: n, idx(:)
integer(psb_mpk_) :: n
integer(psb_ipk_) :: idx(:)
complex(psb_dpk_) :: x(:), y(:)
end subroutine psi_zgthzv
end interface psi_gth
interface psi_sct
subroutine psi_zsctmm(n,k,idx,x,beta,y)
import :: psb_ipk_, psb_dpk_
import :: psb_ipk_, psb_mpk_, psb_dpk_
implicit none
integer(psb_ipk_) :: n, k, idx(:)
integer(psb_mpk_) :: n, k
integer(psb_ipk_) :: idx(:)
complex(psb_dpk_) :: beta, x(:,:), y(:,:)
end subroutine psi_zsctmm
subroutine psi_zsctmv(n,k,idx,x,beta,y)
import :: psb_ipk_, psb_dpk_
import :: psb_ipk_, psb_mpk_, psb_dpk_
implicit none
integer(psb_ipk_) :: n, k, idx(:)
integer(psb_mpk_) :: n, k
integer(psb_ipk_) :: idx(:)
complex(psb_dpk_) :: beta, x(:), y(:,:)
end subroutine psi_zsctmv
subroutine psi_zsctv(n,idx,x,beta,y)
import :: psb_ipk_, psb_dpk_
import :: psb_ipk_, psb_mpk_, psb_dpk_
implicit none
integer(psb_ipk_) :: n, idx(:)
integer(psb_mpk_) :: n
integer(psb_ipk_) :: idx(:)
complex(psb_dpk_) :: beta, x(:), y(:)
end subroutine psi_zsctv
end interface psi_sct
interface psi_exscan
subroutine psi_z_exscanv(n,x,info,shift)
import :: psb_ipk_, psb_dpk_
import :: psb_ipk_, psb_mpk_, psb_dpk_
implicit none
integer(psb_ipk_), intent(in) :: n
complex(psb_dpk_), intent (inout) :: x(:)

@ -36,7 +36,8 @@ module psi_c_comm_a_mod
interface psi_swapdata
subroutine psi_cswapdatam(flag,n,beta,y,desc_a,work,info,data)
import
integer(psb_ipk_), intent(in) :: flag, n
integer(psb_mpk_), intent(in) :: n
integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info
complex(psb_spk_) :: y(:,:), beta
complex(psb_spk_),target :: work(:)
@ -57,7 +58,8 @@ module psi_c_comm_a_mod
import
type(psb_ctxt_type), intent(in) :: ctxt
integer(psb_mpk_), intent(in) :: icomm
integer(psb_ipk_), intent(in) :: flag, n
integer(psb_mpk_), intent(in) :: n
integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info
complex(psb_spk_) :: y(:,:), beta
complex(psb_spk_),target :: work(:)
@ -80,7 +82,8 @@ module psi_c_comm_a_mod
interface psi_swaptran
subroutine psi_cswaptranm(flag,n,beta,y,desc_a,work,info,data)
import
integer(psb_ipk_), intent(in) :: flag, n
integer(psb_ipk_), intent(in) :: flag
integer(psb_Mpk_), intent(in) :: n
integer(psb_ipk_), intent(out) :: info
complex(psb_spk_) :: y(:,:), beta
complex(psb_spk_),target :: work(:)
@ -101,7 +104,8 @@ module psi_c_comm_a_mod
import
type(psb_ctxt_type), intent(in) :: ctxt
integer(psb_mpk_), intent(in) :: icomm
integer(psb_ipk_), intent(in) :: flag, n
integer(psb_mpk_), intent(in) :: n
integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info
complex(psb_spk_) :: y(:,:), beta
complex(psb_spk_),target :: work(:)

@ -36,7 +36,8 @@ module psi_d_comm_a_mod
interface psi_swapdata
subroutine psi_dswapdatam(flag,n,beta,y,desc_a,work,info,data)
import
integer(psb_ipk_), intent(in) :: flag, n
integer(psb_mpk_), intent(in) :: n
integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info
real(psb_dpk_) :: y(:,:), beta
real(psb_dpk_),target :: work(:)
@ -57,7 +58,8 @@ module psi_d_comm_a_mod
import
type(psb_ctxt_type), intent(in) :: ctxt
integer(psb_mpk_), intent(in) :: icomm
integer(psb_ipk_), intent(in) :: flag, n
integer(psb_mpk_), intent(in) :: n
integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info
real(psb_dpk_) :: y(:,:), beta
real(psb_dpk_),target :: work(:)
@ -80,7 +82,8 @@ module psi_d_comm_a_mod
interface psi_swaptran
subroutine psi_dswaptranm(flag,n,beta,y,desc_a,work,info,data)
import
integer(psb_ipk_), intent(in) :: flag, n
integer(psb_ipk_), intent(in) :: flag
integer(psb_Mpk_), intent(in) :: n
integer(psb_ipk_), intent(out) :: info
real(psb_dpk_) :: y(:,:), beta
real(psb_dpk_),target :: work(:)
@ -101,7 +104,8 @@ module psi_d_comm_a_mod
import
type(psb_ctxt_type), intent(in) :: ctxt
integer(psb_mpk_), intent(in) :: icomm
integer(psb_ipk_), intent(in) :: flag, n
integer(psb_mpk_), intent(in) :: n
integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info
real(psb_dpk_) :: y(:,:), beta
real(psb_dpk_),target :: work(:)

@ -36,7 +36,8 @@ module psi_e_comm_a_mod
interface psi_swapdata
subroutine psi_eswapdatam(flag,n,beta,y,desc_a,work,info,data)
import
integer(psb_ipk_), intent(in) :: flag, n
integer(psb_mpk_), intent(in) :: n
integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info
integer(psb_epk_) :: y(:,:), beta
integer(psb_epk_),target :: work(:)
@ -57,7 +58,8 @@ module psi_e_comm_a_mod
import
type(psb_ctxt_type), intent(in) :: ctxt
integer(psb_mpk_), intent(in) :: icomm
integer(psb_ipk_), intent(in) :: flag, n
integer(psb_mpk_), intent(in) :: n
integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info
integer(psb_epk_) :: y(:,:), beta
integer(psb_epk_),target :: work(:)
@ -80,7 +82,8 @@ module psi_e_comm_a_mod
interface psi_swaptran
subroutine psi_eswaptranm(flag,n,beta,y,desc_a,work,info,data)
import
integer(psb_ipk_), intent(in) :: flag, n
integer(psb_ipk_), intent(in) :: flag
integer(psb_Mpk_), intent(in) :: n
integer(psb_ipk_), intent(out) :: info
integer(psb_epk_) :: y(:,:), beta
integer(psb_epk_),target :: work(:)
@ -101,7 +104,8 @@ module psi_e_comm_a_mod
import
type(psb_ctxt_type), intent(in) :: ctxt
integer(psb_mpk_), intent(in) :: icomm
integer(psb_ipk_), intent(in) :: flag, n
integer(psb_mpk_), intent(in) :: n
integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info
integer(psb_epk_) :: y(:,:), beta
integer(psb_epk_),target :: work(:)

@ -36,7 +36,8 @@ module psi_i2_comm_a_mod
interface psi_swapdata
subroutine psi_i2swapdatam(flag,n,beta,y,desc_a,work,info,data)
import
integer(psb_ipk_), intent(in) :: flag, n
integer(psb_mpk_), intent(in) :: n
integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info
integer(psb_i2pk_) :: y(:,:), beta
integer(psb_i2pk_),target :: work(:)
@ -57,7 +58,8 @@ module psi_i2_comm_a_mod
import
type(psb_ctxt_type), intent(in) :: ctxt
integer(psb_mpk_), intent(in) :: icomm
integer(psb_ipk_), intent(in) :: flag, n
integer(psb_mpk_), intent(in) :: n
integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info
integer(psb_i2pk_) :: y(:,:), beta
integer(psb_i2pk_),target :: work(:)
@ -80,7 +82,8 @@ module psi_i2_comm_a_mod
interface psi_swaptran
subroutine psi_i2swaptranm(flag,n,beta,y,desc_a,work,info,data)
import
integer(psb_ipk_), intent(in) :: flag, n
integer(psb_ipk_), intent(in) :: flag
integer(psb_Mpk_), intent(in) :: n
integer(psb_ipk_), intent(out) :: info
integer(psb_i2pk_) :: y(:,:), beta
integer(psb_i2pk_),target :: work(:)
@ -101,7 +104,8 @@ module psi_i2_comm_a_mod
import
type(psb_ctxt_type), intent(in) :: ctxt
integer(psb_mpk_), intent(in) :: icomm
integer(psb_ipk_), intent(in) :: flag, n
integer(psb_mpk_), intent(in) :: n
integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info
integer(psb_i2pk_) :: y(:,:), beta
integer(psb_i2pk_),target :: work(:)

@ -36,7 +36,8 @@ module psi_m_comm_a_mod
interface psi_swapdata
subroutine psi_mswapdatam(flag,n,beta,y,desc_a,work,info,data)
import
integer(psb_ipk_), intent(in) :: flag, n
integer(psb_mpk_), intent(in) :: n
integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info
integer(psb_mpk_) :: y(:,:), beta
integer(psb_mpk_),target :: work(:)
@ -57,7 +58,8 @@ module psi_m_comm_a_mod
import
type(psb_ctxt_type), intent(in) :: ctxt
integer(psb_mpk_), intent(in) :: icomm
integer(psb_ipk_), intent(in) :: flag, n
integer(psb_mpk_), intent(in) :: n
integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info
integer(psb_mpk_) :: y(:,:), beta
integer(psb_mpk_),target :: work(:)
@ -80,7 +82,8 @@ module psi_m_comm_a_mod
interface psi_swaptran
subroutine psi_mswaptranm(flag,n,beta,y,desc_a,work,info,data)
import
integer(psb_ipk_), intent(in) :: flag, n
integer(psb_ipk_), intent(in) :: flag
integer(psb_Mpk_), intent(in) :: n
integer(psb_ipk_), intent(out) :: info
integer(psb_mpk_) :: y(:,:), beta
integer(psb_mpk_),target :: work(:)
@ -101,7 +104,8 @@ module psi_m_comm_a_mod
import
type(psb_ctxt_type), intent(in) :: ctxt
integer(psb_mpk_), intent(in) :: icomm
integer(psb_ipk_), intent(in) :: flag, n
integer(psb_mpk_), intent(in) :: n
integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info
integer(psb_mpk_) :: y(:,:), beta
integer(psb_mpk_),target :: work(:)

@ -36,7 +36,8 @@ module psi_s_comm_a_mod
interface psi_swapdata
subroutine psi_sswapdatam(flag,n,beta,y,desc_a,work,info,data)
import
integer(psb_ipk_), intent(in) :: flag, n
integer(psb_mpk_), intent(in) :: n
integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info
real(psb_spk_) :: y(:,:), beta
real(psb_spk_),target :: work(:)
@ -57,7 +58,8 @@ module psi_s_comm_a_mod
import
type(psb_ctxt_type), intent(in) :: ctxt
integer(psb_mpk_), intent(in) :: icomm
integer(psb_ipk_), intent(in) :: flag, n
integer(psb_mpk_), intent(in) :: n
integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info
real(psb_spk_) :: y(:,:), beta
real(psb_spk_),target :: work(:)
@ -80,7 +82,8 @@ module psi_s_comm_a_mod
interface psi_swaptran
subroutine psi_sswaptranm(flag,n,beta,y,desc_a,work,info,data)
import
integer(psb_ipk_), intent(in) :: flag, n
integer(psb_ipk_), intent(in) :: flag
integer(psb_Mpk_), intent(in) :: n
integer(psb_ipk_), intent(out) :: info
real(psb_spk_) :: y(:,:), beta
real(psb_spk_),target :: work(:)
@ -101,7 +104,8 @@ module psi_s_comm_a_mod
import
type(psb_ctxt_type), intent(in) :: ctxt
integer(psb_mpk_), intent(in) :: icomm
integer(psb_ipk_), intent(in) :: flag, n
integer(psb_mpk_), intent(in) :: n
integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info
real(psb_spk_) :: y(:,:), beta
real(psb_spk_),target :: work(:)

@ -36,7 +36,8 @@ module psi_z_comm_a_mod
interface psi_swapdata
subroutine psi_zswapdatam(flag,n,beta,y,desc_a,work,info,data)
import
integer(psb_ipk_), intent(in) :: flag, n
integer(psb_mpk_), intent(in) :: n
integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info
complex(psb_dpk_) :: y(:,:), beta
complex(psb_dpk_),target :: work(:)
@ -57,7 +58,8 @@ module psi_z_comm_a_mod
import
type(psb_ctxt_type), intent(in) :: ctxt
integer(psb_mpk_), intent(in) :: icomm
integer(psb_ipk_), intent(in) :: flag, n
integer(psb_mpk_), intent(in) :: n
integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info
complex(psb_dpk_) :: y(:,:), beta
complex(psb_dpk_),target :: work(:)
@ -80,7 +82,8 @@ module psi_z_comm_a_mod
interface psi_swaptran
subroutine psi_zswaptranm(flag,n,beta,y,desc_a,work,info,data)
import
integer(psb_ipk_), intent(in) :: flag, n
integer(psb_ipk_), intent(in) :: flag
integer(psb_Mpk_), intent(in) :: n
integer(psb_ipk_), intent(out) :: info
complex(psb_dpk_) :: y(:,:), beta
complex(psb_dpk_),target :: work(:)
@ -101,7 +104,8 @@ module psi_z_comm_a_mod
import
type(psb_ctxt_type), intent(in) :: ctxt
integer(psb_mpk_), intent(in) :: icomm
integer(psb_ipk_), intent(in) :: flag, n
integer(psb_mpk_), intent(in) :: n
integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info
complex(psb_dpk_) :: y(:,:), beta
complex(psb_dpk_),target :: work(:)

@ -108,7 +108,7 @@ module psb_desc_const_mod
integer(psb_ipk_), parameter :: psb_max_hash_bits = 22
integer(psb_ipk_), parameter :: psb_hash_size = 2**psb_hash_bits, psb_hash_mask=psb_hash_size-1
integer(psb_ipk_), parameter :: psb_hpnt_nentries_ = 7
integer(psb_ipk_), parameter :: psb_default_large_threshold=1*1024*1024
integer(psb_ipk_), parameter :: psb_default_hash_threshold=1*1024*1024
!
! Choice of algorithm for sparse matrix A2AV
!

@ -285,14 +285,14 @@ module psb_desc_mod
module procedure psb_cdfree
end interface psb_free
interface psb_cd_set_large_threshold
module procedure psb_i_cd_set_large_threshold
end interface psb_cd_set_large_threshold
interface psb_cd_set_hash_threshold
module procedure psb_i_cd_set_hash_threshold
end interface psb_cd_set_hash_threshold
#if defined(PSB_IPK4) && defined(PSB_LPK8)
interface psb_cd_set_large_threshold
module procedure psb_l_cd_set_large_threshold
end interface psb_cd_set_large_threshold
interface psb_cd_set_hash_threshold
module procedure psb_l_cd_set_hash_threshold
end interface psb_cd_set_hash_threshold
#endif
interface psb_set_sp_a2av_alg
@ -309,7 +309,7 @@ module psb_desc_mod
& cd_g2ls2_ins, cd_g2lv1_ins, cd_g2lv2_ins, cd_fnd_owner
integer(psb_lpk_), private, save :: cd_large_threshold = psb_default_large_threshold
integer(psb_lpk_), private, save :: cd_hash_threshold = psb_default_hash_threshold
integer(psb_ipk_), private, save :: sp_a2av_alg = psb_sp_a2av_smpl_triad_
contains
@ -363,27 +363,27 @@ contains
subroutine psb_i_cd_set_large_threshold(ith)
subroutine psb_i_cd_set_hash_threshold(ith)
implicit none
integer(psb_ipk_), intent(in) :: ith
if (ith > 0) then
cd_large_threshold = ith
cd_hash_threshold = ith
end if
end subroutine psb_i_cd_set_large_threshold
end subroutine psb_i_cd_set_hash_threshold
subroutine psb_l_cd_set_large_threshold(ith)
subroutine psb_l_cd_set_hash_threshold(ith)
implicit none
integer(psb_lpk_), intent(in) :: ith
if (ith > 0) then
cd_large_threshold = ith
cd_hash_threshold = ith
end if
end subroutine psb_l_cd_set_large_threshold
end subroutine psb_l_cd_set_hash_threshold
function psb_cd_get_large_threshold() result(val)
function psb_cd_get_hash_threshold() result(val)
implicit none
integer(psb_lpk_) :: val
val = cd_large_threshold
end function psb_cd_get_large_threshold
val = cd_hash_threshold
end function psb_cd_get_hash_threshold
function psb_cd_is_large_size(m) result(val)
use psb_penv_mod
@ -392,7 +392,7 @@ contains
integer(psb_lpk_), intent(in) :: m
logical :: val
!locals
val = (m > psb_cd_get_large_threshold())
val = (m > psb_cd_get_hash_threshold())
end function psb_cd_is_large_size
function psb_cd_choose_large_state(ctxt,m) result(val)

File diff suppressed because it is too large Load Diff

@ -1221,8 +1221,8 @@ contains
integer(psb_mpk_), intent(inout), optional :: request
complex(psb_spk_), intent(inout) :: dat
complex(psb_spk_) :: dat_
integer(psb_ipk_) :: iam, np, info
integer(psb_mpk_) :: minfo
integer(psb_ipk_) :: info
integer(psb_mpk_) :: iam, np, minfo
integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
logical :: collective_start, collective_end, collective_sync
@ -1256,6 +1256,7 @@ contains
call mpi_wait(request,status,minfo)
end if
end if
info = minfo
#endif
end subroutine psb_cscan_sums
@ -1272,8 +1273,8 @@ contains
integer(psb_ipk_), intent(in), optional :: mode
integer(psb_mpk_), intent(inout), optional :: request
complex(psb_spk_) :: dat_
integer(psb_ipk_) :: iam, np, info
integer(psb_mpk_) :: minfo
integer(psb_ipk_) :: info
integer(psb_mpk_) :: iam, np, minfo
integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
logical :: collective_start, collective_end, collective_sync
@ -1308,6 +1309,7 @@ contains
call mpi_wait(request,status,minfo)
end if
end if
info = minfo
#else
dat = czero
#endif
@ -1326,8 +1328,8 @@ contains
integer(psb_ipk_), intent(in), optional :: mode
integer(psb_mpk_), intent(inout), optional :: request
integer(psb_ipk_) :: iam, np, info
integer(psb_mpk_) :: minfo
integer(psb_ipk_) :: info
integer(psb_mpk_) :: iam, np, minfo
integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
logical :: collective_start, collective_end, collective_sync
@ -1356,11 +1358,12 @@ contains
else
if (collective_start) then
call mpi_iscan(dat_,dat,size(dat),&
& psb_mpi_c_spk_,mpi_sum,icomm,request,info)
& psb_mpi_c_spk_,mpi_sum,icomm,request,minfo)
else if (collective_end) then
call mpi_wait(request,status,info)
call mpi_wait(request,status,minfo)
end if
end if
info = minfo
#endif
end subroutine psb_cscan_sumv
@ -1377,8 +1380,8 @@ contains
integer(psb_ipk_), intent(in), optional :: mode
integer(psb_mpk_), intent(inout), optional :: request
integer(psb_ipk_) :: iam, np, info
integer(psb_mpk_) :: minfo
integer(psb_ipk_) :: info
integer(psb_mpk_) :: iam, np, minfo
integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
logical :: collective_start, collective_end, collective_sync
@ -1408,12 +1411,12 @@ contains
else
if (collective_start) then
call mpi_iexscan(dat_,dat,size(dat),&
& psb_mpi_c_spk_,mpi_sum,icomm,request,info)
& psb_mpi_c_spk_,mpi_sum,icomm,request,minfo)
else if (collective_end) then
call mpi_wait(request,status,info)
call mpi_wait(request,status,minfo)
end if
end if
info = minfo
#else
dat = czero
#endif
@ -1428,7 +1431,9 @@ contains
integer(psb_mpk_), intent(in) :: bsdindx(:), brvindx(:), sdsz(:), rvsz(:)
type(psb_ctxt_type), intent(in) :: ctxt
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: iam, np, i,j,k, ip, ipx, idx, sz
integer(psb_ipk_) :: i,j,k, ipx, idx
integer(psb_mpk_) :: ip, sz
integer(psb_mpk_) :: iam, np
call psb_info(ctxt,iam,np)
@ -1473,9 +1478,11 @@ contains
integer(psb_ipk_), intent(out) :: info
!Local variables
integer(psb_ipk_) :: iam, np, i,j,k, ip, ipx, idx, sz, counter
integer(psb_ipk_) :: i,j,k, ipx, idx, counter
integer(psb_mpk_) :: proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret, icomm
integer(psb_mpk_), allocatable :: prcid(:), rvhd(:,:)
integer(psb_mpk_) :: ip, sz
integer(psb_mpk_) :: iam, np
call psb_info(ctxt,iam,np)
@ -1556,9 +1563,11 @@ contains
integer(psb_ipk_), intent(out) :: info
!Local variables
integer(psb_ipk_) :: iam, np, i,j,k, ip, ipx, idx, sz, counter
integer(psb_ipk_) :: i,j,k, ipx, idx, counter
integer(psb_mpk_) :: proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret, icomm
integer(psb_mpk_), allocatable :: prcid(:), rvhd(:,:)
integer(psb_mpk_) :: ip, sz
integer(psb_mpk_) :: iam, np
call psb_info(ctxt,iam,np)

@ -1861,8 +1861,8 @@ contains
integer(psb_mpk_), intent(inout), optional :: request
real(psb_dpk_), intent(inout) :: dat
real(psb_dpk_) :: dat_
integer(psb_ipk_) :: iam, np, info
integer(psb_mpk_) :: minfo
integer(psb_ipk_) :: info
integer(psb_mpk_) :: iam, np, minfo
integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
logical :: collective_start, collective_end, collective_sync
@ -1896,6 +1896,7 @@ contains
call mpi_wait(request,status,minfo)
end if
end if
info = minfo
#endif
end subroutine psb_dscan_sums
@ -1912,8 +1913,8 @@ contains
integer(psb_ipk_), intent(in), optional :: mode
integer(psb_mpk_), intent(inout), optional :: request
real(psb_dpk_) :: dat_
integer(psb_ipk_) :: iam, np, info
integer(psb_mpk_) :: minfo
integer(psb_ipk_) :: info
integer(psb_mpk_) :: iam, np, minfo
integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
logical :: collective_start, collective_end, collective_sync
@ -1948,6 +1949,7 @@ contains
call mpi_wait(request,status,minfo)
end if
end if
info = minfo
#else
dat = dzero
#endif
@ -1966,8 +1968,8 @@ contains
integer(psb_ipk_), intent(in), optional :: mode
integer(psb_mpk_), intent(inout), optional :: request
integer(psb_ipk_) :: iam, np, info
integer(psb_mpk_) :: minfo
integer(psb_ipk_) :: info
integer(psb_mpk_) :: iam, np, minfo
integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
logical :: collective_start, collective_end, collective_sync
@ -1996,11 +1998,12 @@ contains
else
if (collective_start) then
call mpi_iscan(dat_,dat,size(dat),&
& psb_mpi_r_dpk_,mpi_sum,icomm,request,info)
& psb_mpi_r_dpk_,mpi_sum,icomm,request,minfo)
else if (collective_end) then
call mpi_wait(request,status,info)
call mpi_wait(request,status,minfo)
end if
end if
info = minfo
#endif
end subroutine psb_dscan_sumv
@ -2017,8 +2020,8 @@ contains
integer(psb_ipk_), intent(in), optional :: mode
integer(psb_mpk_), intent(inout), optional :: request
integer(psb_ipk_) :: iam, np, info
integer(psb_mpk_) :: minfo
integer(psb_ipk_) :: info
integer(psb_mpk_) :: iam, np, minfo
integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
logical :: collective_start, collective_end, collective_sync
@ -2048,12 +2051,12 @@ contains
else
if (collective_start) then
call mpi_iexscan(dat_,dat,size(dat),&
& psb_mpi_r_dpk_,mpi_sum,icomm,request,info)
& psb_mpi_r_dpk_,mpi_sum,icomm,request,minfo)
else if (collective_end) then
call mpi_wait(request,status,info)
call mpi_wait(request,status,minfo)
end if
end if
info = minfo
#else
dat = dzero
#endif
@ -2068,7 +2071,9 @@ contains
integer(psb_mpk_), intent(in) :: bsdindx(:), brvindx(:), sdsz(:), rvsz(:)
type(psb_ctxt_type), intent(in) :: ctxt
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: iam, np, i,j,k, ip, ipx, idx, sz
integer(psb_ipk_) :: i,j,k, ipx, idx
integer(psb_mpk_) :: ip, sz
integer(psb_mpk_) :: iam, np
call psb_info(ctxt,iam,np)
@ -2113,9 +2118,11 @@ contains
integer(psb_ipk_), intent(out) :: info
!Local variables
integer(psb_ipk_) :: iam, np, i,j,k, ip, ipx, idx, sz, counter
integer(psb_ipk_) :: i,j,k, ipx, idx, counter
integer(psb_mpk_) :: proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret, icomm
integer(psb_mpk_), allocatable :: prcid(:), rvhd(:,:)
integer(psb_mpk_) :: ip, sz
integer(psb_mpk_) :: iam, np
call psb_info(ctxt,iam,np)
@ -2196,9 +2203,11 @@ contains
integer(psb_ipk_), intent(out) :: info
!Local variables
integer(psb_ipk_) :: iam, np, i,j,k, ip, ipx, idx, sz, counter
integer(psb_ipk_) :: i,j,k, ipx, idx, counter
integer(psb_mpk_) :: proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret, icomm
integer(psb_mpk_), allocatable :: prcid(:), rvhd(:,:)
integer(psb_mpk_) :: ip, sz
integer(psb_mpk_) :: iam, np
call psb_info(ctxt,iam,np)

@ -1699,8 +1699,8 @@ contains
integer(psb_mpk_), intent(inout), optional :: request
integer(psb_epk_), intent(inout) :: dat
integer(psb_epk_) :: dat_
integer(psb_ipk_) :: iam, np, info
integer(psb_mpk_) :: minfo
integer(psb_ipk_) :: info
integer(psb_mpk_) :: iam, np, minfo
integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
logical :: collective_start, collective_end, collective_sync
@ -1734,6 +1734,7 @@ contains
call mpi_wait(request,status,minfo)
end if
end if
info = minfo
#endif
end subroutine psb_escan_sums
@ -1750,8 +1751,8 @@ contains
integer(psb_ipk_), intent(in), optional :: mode
integer(psb_mpk_), intent(inout), optional :: request
integer(psb_epk_) :: dat_
integer(psb_ipk_) :: iam, np, info
integer(psb_mpk_) :: minfo
integer(psb_ipk_) :: info
integer(psb_mpk_) :: iam, np, minfo
integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
logical :: collective_start, collective_end, collective_sync
@ -1786,6 +1787,7 @@ contains
call mpi_wait(request,status,minfo)
end if
end if
info = minfo
#else
dat = ezero
#endif
@ -1804,8 +1806,8 @@ contains
integer(psb_ipk_), intent(in), optional :: mode
integer(psb_mpk_), intent(inout), optional :: request
integer(psb_ipk_) :: iam, np, info
integer(psb_mpk_) :: minfo
integer(psb_ipk_) :: info
integer(psb_mpk_) :: iam, np, minfo
integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
logical :: collective_start, collective_end, collective_sync
@ -1834,11 +1836,12 @@ contains
else
if (collective_start) then
call mpi_iscan(dat_,dat,size(dat),&
& psb_mpi_epk_,mpi_sum,icomm,request,info)
& psb_mpi_epk_,mpi_sum,icomm,request,minfo)
else if (collective_end) then
call mpi_wait(request,status,info)
call mpi_wait(request,status,minfo)
end if
end if
info = minfo
#endif
end subroutine psb_escan_sumv
@ -1855,8 +1858,8 @@ contains
integer(psb_ipk_), intent(in), optional :: mode
integer(psb_mpk_), intent(inout), optional :: request
integer(psb_ipk_) :: iam, np, info
integer(psb_mpk_) :: minfo
integer(psb_ipk_) :: info
integer(psb_mpk_) :: iam, np, minfo
integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
logical :: collective_start, collective_end, collective_sync
@ -1886,12 +1889,12 @@ contains
else
if (collective_start) then
call mpi_iexscan(dat_,dat,size(dat),&
& psb_mpi_epk_,mpi_sum,icomm,request,info)
& psb_mpi_epk_,mpi_sum,icomm,request,minfo)
else if (collective_end) then
call mpi_wait(request,status,info)
call mpi_wait(request,status,minfo)
end if
end if
info = minfo
#else
dat = ezero
#endif
@ -1906,7 +1909,9 @@ contains
integer(psb_mpk_), intent(in) :: bsdindx(:), brvindx(:), sdsz(:), rvsz(:)
type(psb_ctxt_type), intent(in) :: ctxt
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: iam, np, i,j,k, ip, ipx, idx, sz
integer(psb_ipk_) :: i,j,k, ipx, idx
integer(psb_mpk_) :: ip, sz
integer(psb_mpk_) :: iam, np
call psb_info(ctxt,iam,np)
@ -1951,9 +1956,11 @@ contains
integer(psb_ipk_), intent(out) :: info
!Local variables
integer(psb_ipk_) :: iam, np, i,j,k, ip, ipx, idx, sz, counter
integer(psb_ipk_) :: i,j,k, ipx, idx, counter
integer(psb_mpk_) :: proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret, icomm
integer(psb_mpk_), allocatable :: prcid(:), rvhd(:,:)
integer(psb_mpk_) :: ip, sz
integer(psb_mpk_) :: iam, np
call psb_info(ctxt,iam,np)
@ -2034,9 +2041,11 @@ contains
integer(psb_ipk_), intent(out) :: info
!Local variables
integer(psb_ipk_) :: iam, np, i,j,k, ip, ipx, idx, sz, counter
integer(psb_ipk_) :: i,j,k, ipx, idx, counter
integer(psb_mpk_) :: proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret, icomm
integer(psb_mpk_), allocatable :: prcid(:), rvhd(:,:)
integer(psb_mpk_) :: ip, sz
integer(psb_mpk_) :: iam, np
call psb_info(ctxt,iam,np)

@ -1699,8 +1699,8 @@ contains
integer(psb_mpk_), intent(inout), optional :: request
integer(psb_i2pk_), intent(inout) :: dat
integer(psb_i2pk_) :: dat_
integer(psb_ipk_) :: iam, np, info
integer(psb_mpk_) :: minfo
integer(psb_ipk_) :: info
integer(psb_mpk_) :: iam, np, minfo
integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
logical :: collective_start, collective_end, collective_sync
@ -1734,6 +1734,7 @@ contains
call mpi_wait(request,status,minfo)
end if
end if
info = minfo
#endif
end subroutine psb_i2scan_sums
@ -1750,8 +1751,8 @@ contains
integer(psb_ipk_), intent(in), optional :: mode
integer(psb_mpk_), intent(inout), optional :: request
integer(psb_i2pk_) :: dat_
integer(psb_ipk_) :: iam, np, info
integer(psb_mpk_) :: minfo
integer(psb_ipk_) :: info
integer(psb_mpk_) :: iam, np, minfo
integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
logical :: collective_start, collective_end, collective_sync
@ -1786,6 +1787,7 @@ contains
call mpi_wait(request,status,minfo)
end if
end if
info = minfo
#else
dat = i2zero
#endif
@ -1804,8 +1806,8 @@ contains
integer(psb_ipk_), intent(in), optional :: mode
integer(psb_mpk_), intent(inout), optional :: request
integer(psb_ipk_) :: iam, np, info
integer(psb_mpk_) :: minfo
integer(psb_ipk_) :: info
integer(psb_mpk_) :: iam, np, minfo
integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
logical :: collective_start, collective_end, collective_sync
@ -1834,11 +1836,12 @@ contains
else
if (collective_start) then
call mpi_iscan(dat_,dat,size(dat),&
& psb_mpi_i2pk_,mpi_sum,icomm,request,info)
& psb_mpi_i2pk_,mpi_sum,icomm,request,minfo)
else if (collective_end) then
call mpi_wait(request,status,info)
call mpi_wait(request,status,minfo)
end if
end if
info = minfo
#endif
end subroutine psb_i2scan_sumv
@ -1855,8 +1858,8 @@ contains
integer(psb_ipk_), intent(in), optional :: mode
integer(psb_mpk_), intent(inout), optional :: request
integer(psb_ipk_) :: iam, np, info
integer(psb_mpk_) :: minfo
integer(psb_ipk_) :: info
integer(psb_mpk_) :: iam, np, minfo
integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
logical :: collective_start, collective_end, collective_sync
@ -1886,12 +1889,12 @@ contains
else
if (collective_start) then
call mpi_iexscan(dat_,dat,size(dat),&
& psb_mpi_i2pk_,mpi_sum,icomm,request,info)
& psb_mpi_i2pk_,mpi_sum,icomm,request,minfo)
else if (collective_end) then
call mpi_wait(request,status,info)
call mpi_wait(request,status,minfo)
end if
end if
info = minfo
#else
dat = i2zero
#endif
@ -1906,7 +1909,9 @@ contains
integer(psb_mpk_), intent(in) :: bsdindx(:), brvindx(:), sdsz(:), rvsz(:)
type(psb_ctxt_type), intent(in) :: ctxt
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: iam, np, i,j,k, ip, ipx, idx, sz
integer(psb_ipk_) :: i,j,k, ipx, idx
integer(psb_mpk_) :: ip, sz
integer(psb_mpk_) :: iam, np
call psb_info(ctxt,iam,np)
@ -1951,9 +1956,11 @@ contains
integer(psb_ipk_), intent(out) :: info
!Local variables
integer(psb_ipk_) :: iam, np, i,j,k, ip, ipx, idx, sz, counter
integer(psb_ipk_) :: i,j,k, ipx, idx, counter
integer(psb_mpk_) :: proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret, icomm
integer(psb_mpk_), allocatable :: prcid(:), rvhd(:,:)
integer(psb_mpk_) :: ip, sz
integer(psb_mpk_) :: iam, np
call psb_info(ctxt,iam,np)
@ -2034,9 +2041,11 @@ contains
integer(psb_ipk_), intent(out) :: info
!Local variables
integer(psb_ipk_) :: iam, np, i,j,k, ip, ipx, idx, sz, counter
integer(psb_ipk_) :: i,j,k, ipx, idx, counter
integer(psb_mpk_) :: proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret, icomm
integer(psb_mpk_), allocatable :: prcid(:), rvhd(:,:)
integer(psb_mpk_) :: ip, sz
integer(psb_mpk_) :: iam, np
call psb_info(ctxt,iam,np)

@ -1699,8 +1699,8 @@ contains
integer(psb_mpk_), intent(inout), optional :: request
integer(psb_mpk_), intent(inout) :: dat
integer(psb_mpk_) :: dat_
integer(psb_ipk_) :: iam, np, info
integer(psb_mpk_) :: minfo
integer(psb_ipk_) :: info
integer(psb_mpk_) :: iam, np, minfo
integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
logical :: collective_start, collective_end, collective_sync
@ -1734,6 +1734,7 @@ contains
call mpi_wait(request,status,minfo)
end if
end if
info = minfo
#endif
end subroutine psb_mscan_sums
@ -1750,8 +1751,8 @@ contains
integer(psb_ipk_), intent(in), optional :: mode
integer(psb_mpk_), intent(inout), optional :: request
integer(psb_mpk_) :: dat_
integer(psb_ipk_) :: iam, np, info
integer(psb_mpk_) :: minfo
integer(psb_ipk_) :: info
integer(psb_mpk_) :: iam, np, minfo
integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
logical :: collective_start, collective_end, collective_sync
@ -1786,6 +1787,7 @@ contains
call mpi_wait(request,status,minfo)
end if
end if
info = minfo
#else
dat = mzero
#endif
@ -1804,8 +1806,8 @@ contains
integer(psb_ipk_), intent(in), optional :: mode
integer(psb_mpk_), intent(inout), optional :: request
integer(psb_ipk_) :: iam, np, info
integer(psb_mpk_) :: minfo
integer(psb_ipk_) :: info
integer(psb_mpk_) :: iam, np, minfo
integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
logical :: collective_start, collective_end, collective_sync
@ -1834,11 +1836,12 @@ contains
else
if (collective_start) then
call mpi_iscan(dat_,dat,size(dat),&
& psb_mpi_mpk_,mpi_sum,icomm,request,info)
& psb_mpi_mpk_,mpi_sum,icomm,request,minfo)
else if (collective_end) then
call mpi_wait(request,status,info)
call mpi_wait(request,status,minfo)
end if
end if
info = minfo
#endif
end subroutine psb_mscan_sumv
@ -1855,8 +1858,8 @@ contains
integer(psb_ipk_), intent(in), optional :: mode
integer(psb_mpk_), intent(inout), optional :: request
integer(psb_ipk_) :: iam, np, info
integer(psb_mpk_) :: minfo
integer(psb_ipk_) :: info
integer(psb_mpk_) :: iam, np, minfo
integer(psb_mpk_) :: icomm
integer(psb_mpk_) :: status(mpi_status_size)
logical :: collective_start, collective_end, collective_sync
@ -1886,12 +1889,12 @@ contains
else
if (collective_start) then
call mpi_iexscan(dat_,dat,size(dat),&
& psb_mpi_mpk_,mpi_sum,icomm,request,info)
& psb_mpi_mpk_,mpi_sum,icomm,request,minfo)
else if (collective_end) then
call mpi_wait(request,status,info)
call mpi_wait(request,status,minfo)
end if
end if
info = minfo
#else
dat = mzero
#endif
@ -1906,7 +1909,9 @@ contains
integer(psb_mpk_), intent(in) :: bsdindx(:), brvindx(:), sdsz(:), rvsz(:)
type(psb_ctxt_type), intent(in) :: ctxt
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: iam, np, i,j,k, ip, ipx, idx, sz
integer(psb_ipk_) :: i,j,k, ipx, idx
integer(psb_mpk_) :: ip, sz
integer(psb_mpk_) :: iam, np
call psb_info(ctxt,iam,np)
@ -1951,9 +1956,11 @@ contains
integer(psb_ipk_), intent(out) :: info
!Local variables
integer(psb_ipk_) :: iam, np, i,j,k, ip, ipx, idx, sz, counter
integer(psb_ipk_) :: i,j,k, ipx, idx, counter
integer(psb_mpk_) :: proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret, icomm
integer(psb_mpk_), allocatable :: prcid(:), rvhd(:,:)
integer(psb_mpk_) :: ip, sz
integer(psb_mpk_) :: iam, np
call psb_info(ctxt,iam,np)
@ -2034,9 +2041,11 @@ contains
integer(psb_ipk_), intent(out) :: info
!Local variables
integer(psb_ipk_) :: iam, np, i,j,k, ip, ipx, idx, sz, counter
integer(psb_ipk_) :: i,j,k, ipx, idx, counter
integer(psb_mpk_) :: proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret, icomm
integer(psb_mpk_), allocatable :: prcid(:), rvhd(:,:)
integer(psb_mpk_) :: ip, sz
integer(psb_mpk_) :: iam, np
call psb_info(ctxt,iam,np)

@ -263,7 +263,7 @@ module psi_penv_mod
interface psb_info
module procedure psb_info_mpik
end interface
#if defined(PSB_IPK4) && defined(PSB_LPK8)
#if (defined(PSB_IPK4) && defined(PSB_LPK8))||defined(PSB_IPK8)
interface psb_info
module procedure psb_info_epk
end interface
@ -918,7 +918,7 @@ contains
end subroutine psi_register_mpi_extras
#if defined(PSB_IPK4) && defined(PSB_LPK8)
#if (defined(PSB_IPK4) && defined(PSB_LPK8))||defined(PSB_IPK8)
subroutine psb_info_epk(ctxt,iam,np)
type(psb_ctxt_type), intent(in) :: ctxt

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

Loading…
Cancel
Save