diff -Nru arpack-3.7.0/arpackdef.h.in arpack-3.8.0/arpackdef.h.in --- arpack-3.7.0/arpackdef.h.in 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/arpackdef.h.in 2020-12-07 10:40:45.000000000 +0000 @@ -1,10 +1,12 @@ #ifndef __ARPACKDEF_H__ #define __ARPACKDEF_H__ +/* arpackdef.h must be included only by C/C++, not by F77/F90. */ + #define INTERFACE64 @INTERFACE64@ #if INTERFACE64 -#define c_int c_int64_t +#include /* Include this header for int64_t, uint64_t definition. */ #define a_int int64_t #define a_uint uint64_t #else diff -Nru arpack-3.7.0/arpackicb.h.in arpack-3.8.0/arpackicb.h.in --- arpack-3.7.0/arpackicb.h.in 1970-01-01 00:00:00.000000000 +0000 +++ arpack-3.8.0/arpackicb.h.in 2020-12-07 10:40:45.000000000 +0000 @@ -0,0 +1,10 @@ +! arpackicb.h must be included only by F77/F90, not by C/C++. + +#define INTERFACE64 @INTERFACE64@ + +! i_int stands for iso_c_binding int +#if INTERFACE64 +#define i_int c_int64_t +#else +#define i_int c_int +#endif diff -Nru arpack-3.7.0/arpack-ng-config.cmake.in arpack-3.8.0/arpack-ng-config.cmake.in --- arpack-3.7.0/arpack-ng-config.cmake.in 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/arpack-ng-config.cmake.in 2020-12-07 10:40:45.000000000 +0000 @@ -1,14 +1,25 @@ -# Config file for the arpack-ng package. It defines the following variables: -# - arpack_ng_INCLUDE_DIRS - include directories -# - arpack_ng_LIBRARIES - libraries to link against -set(arpack_ng_INCLUDE_DIRS "@CMAKE_INSTALL_PREFIX@/include/arpack" CACHE PATH "arpack-ng: include directories" FORCE) -if(EXISTS "@CMAKE_INSTALL_PREFIX@/lib/libarpack.a") - set(arpack_ng_LIBRARIES "@CMAKE_INSTALL_PREFIX@/lib/libarpack.a" CACHE FILEPATH "arpack-ng: libraries" FORCE) -elseif(EXISTS "@CMAKE_INSTALL_PREFIX@/lib/libarpack.so") - set(arpack_ng_LIBRARIES "@CMAKE_INSTALL_PREFIX@/lib/libarpack.so" CACHE FILEPATH "arpack-ng: libraries" FORCE) -endif() -if(EXISTS "@CMAKE_INSTALL_PREFIX@/lib/libparpack.a") - set(arpack_ng_LIBRARIES "@CMAKE_INSTALL_PREFIX@/lib/libparpack.a;${arpack_ng_LIBRARIES}" CACHE FILEPATH "arpack-ng: libraries" FORCE) -elseif(EXISTS "@CMAKE_INSTALL_PREFIX@/lib/libparpack.so") - set(arpack_ng_LIBRARIES "@CMAKE_INSTALL_PREFIX@/lib/libparpack.so;${arpack_ng_LIBRARIES}" CACHE FILEPATH "arpack-ng: libraries" FORCE) -endif() +# Config file for the arpack-ng package. +# +# To use arpack from CMake, use ARPACK::ARPACK target: +# find_package(arpack-ng) +# add_executable(main main.f) +# target_include_directories(main PRIVATE ARPACK::ARPACK) +# target_link_libraries(main ARPACK::ARPACK) +# +# To use parpack from CMake, use PARPACK::PARPACK target: +# find_package(arpack-ng) +# add_executable(main main.f) +# target_link_libraries(main PARPACK::PARPACK) + +# Create local variables. +set(prefix "@prefix@") +set(exec_prefix "@exec_prefix@") +set(libdir "@libdir@") +set(includedir "@includedir@") + +# Create arpack targets. +add_library(ARPACK::ARPACK INTERFACE IMPORTED) +set_target_properties(ARPACK::ARPACK PROPERTIES INTERFACE_INCLUDE_DIRECTORIES "${includedir}/arpack") +set_target_properties(ARPACK::ARPACK PROPERTIES INTERFACE_LINK_LIBRARIES "arpack") +add_library(PARPACK::PARPACK INTERFACE IMPORTED) +set_target_properties(PARPACK::PARPACK PROPERTIES INTERFACE_LINK_LIBRARIES "parpack") diff -Nru arpack-3.7.0/arpack-ng-config-version.cmake.in arpack-3.8.0/arpack-ng-config-version.cmake.in --- arpack-3.7.0/arpack-ng-config-version.cmake.in 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/arpack-ng-config-version.cmake.in 2020-12-07 10:40:45.000000000 +0000 @@ -1,5 +1,5 @@ # Check whether the requested PACKAGE_FIND_VERSION is compatible -set(PACKAGE_VERSION "@arpack_ng_VERSION@") +set(PACKAGE_VERSION "@PACKAGE_VERSION@") if("${PACKAGE_VERSION}" VERSION_LESS "${PACKAGE_FIND_VERSION}") set(PACKAGE_VERSION_COMPATIBLE FALSE) else() diff -Nru arpack-3.7.0/arpack.pc.in arpack-3.8.0/arpack.pc.in --- arpack-3.7.0/arpack.pc.in 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/arpack.pc.in 1970-01-01 00:00:00.000000000 +0000 @@ -1,12 +0,0 @@ -prefix=@prefix@ -exec_prefix=@exec_prefix@ -libdir=@libdir@ -includedir=@includedir@ - -Name: @PACKAGE_NAME@ -Description: Collection of Fortran77 subroutines designed to solve large scale eigenvalue problems -Version: @PACKAGE_VERSION@ -URL: @PACKAGE_URL@ -Libs: -L${libdir} -larpack@LIBSUFFIX@ -Libs.private: @LAPACK_LIBS@ @BLAS_LIBS@ -Cflags: -I${includedir}/arpack diff -Nru arpack-3.7.0/CHANGES arpack-3.8.0/CHANGES --- arpack-3.7.0/CHANGES 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/CHANGES 2020-12-07 10:40:45.000000000 +0000 @@ -1,3 +1,44 @@ +arpack-ng - 3.8.0 + +[ Myron Oikonomakis ] + * [BUG FIX]: bmat return "G" instead of "B" for generalized matrix in arpack.hpp + * [BUG FIX]: pass arrays of chars as scalar in fortran calls in order not to crash + * when calling subroutines through icb interface + +[ Izaak "Zaak" Beekman ] + * [BUG FIX]: fix 'Unknown CMake command "check_symbol_exists".' when ICB=ON. + +[ Franck Houssen ] + * CI: Support for Mac OS X added in automation (GNU + "-ff2c -fno-second-underscore" options). + * CI: Support for centos added in automation. + * CI: Support for opensuse added in automation. + * arpackSolver/arpackmm: switch eigen version to 3.3. + * [BUG FIX] fix arpackdef.h (resp. arpackicb.h) must be included only by C/C++ (resp. F77/F90). + * [BUG FIX] iparam/ipntr sizes may change depending on cases. + * pyarpack: python binding based on Boost.Python.Numpy exposing C++ API. + * [CLEAN] arpackSolver API: more convenient, suppress template parameters when possible. + * [BUG FIX] ICB using rvec/select: rvec/select turned to integer + bool should be, but, is not always supported (depend on compiler, options). + * extract arpackSolver.hpp from arpakmm.cpp. + * arpackmm: add --slvItrPC option (PC: Jacobi, ILU). + * arpackmm: add --slv LLT LDLT (for SPD matrices). + * arpackmm: add --simplePrec option (to enable use of s*upd). + * arpackmm: add --dense option. + * autotools: provide *.cmake files (in addition to *.pc file). + * [BUG FIX] ILP64 support: using debug_c and stat_c. + * [BUG FIX] fix check precision which may fail with some ATLAS versions. + +[ Kyle Guinn ] + * [BUG FIX]: fix 'eval: Syntax error: "(" unexpected' error at build time. + * Only build shared libraries by default. To build static libraries, use + --enable-static (autotools) or -DBUILD_SHARED_LIBS=OFF (cmake). + * Add parpack.pc and arpackSolver.pc. + +[ David Schwörer ] + * Support of gfortran 10 + + -- Sylvestre Ledru Mon, 07 Dec 2020 11:35:57 +0100 + arpack-ng - 3.7.0 [ Franck Houssen ] @@ -6,15 +47,12 @@ * arpackmm: utility to test arpack with matrix market files. * ICB: add ILP64 support. The idea is: - - cmake generates arpackdef.h from arpackdef.cmake.h.in - - autoheader generates arpackdef.h from arpackdef.autotools.h[.in] - - arpack includes arpackdef.h when/where needed: - - #define provide c_int/a_int according to architecture. - - all f90 who need to include "arpackdef.h" must be moved to F90. - Note: by convention, F90 are preprocessed (f90 are not). + - autoheader/cmake generates arpackdef.h/arpackicb.h from arpackdef.h.in/arpackicb.h.in + - in C/C++ files: arpackdef.h defines a_int according to architecture. + - in F77/F90 files: arpackicb.h defines i_int to architecture. - MPI does not support ILP64: integer*4 must be imposed in all calls involving MPI (f90 example/test code). - To enable ILP64 users to compile/link, arpackdef.h is added in + To enable ILP64 users to compile/link, arpackdef.h/arpackicb.h is added in the arpack installation (make install). [ Kyle Guinn ] @@ -209,7 +247,7 @@ * Replace arpack.pc with proper autotooled arpack.pc.in * Add debug.h to TESTS/Makefile.am sources - * "make dist" is functionnal + * "make dist" is functional * Also build the library "libparpacksrcblacs" (PARPACK/UTIL/BLACS/) -- Sylvestre Ledru Tue, 02 Apr 2013 10:53:08 +0200 @@ -222,7 +260,7 @@ * Compile also PARPACK / MPI example (Closes: #783) * Configure detected built-in LAPACK and BLAS, but refused to use them (Closes: #784) - * Fixed division by zero in smlnum by usind p[d,s]lamch instead of the + * Fixed division by zero in smlnum by using p[d,s]lamch instead of the serial. Thanks to Umberto De Giovannini. -- Sylvestre Ledru Fri, 22 Jun 2012 22:05:41 +0200 diff -Nru arpack-3.7.0/cmake/CoverallsGenerateGcov.cmake arpack-3.8.0/cmake/CoverallsGenerateGcov.cmake --- arpack-3.7.0/cmake/CoverallsGenerateGcov.cmake 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/cmake/CoverallsGenerateGcov.cmake 2020-12-07 10:40:45.000000000 +0000 @@ -63,7 +63,7 @@ # "1;2;3" format to an external process, we have replaced the # ";" with "*", so reverse that here so we get it back into the # CMake list format. -string(REGEX REPLACE "\\*" ";" COVERAGE_SRCS ${COVERAGE_SRCS}) +string(REGEX REPLACE "\\*" ";" COVERAGE_SRCS "${COVERAGE_SRCS}") find_program(GCOV_EXECUTABLE gcov) @@ -127,8 +127,8 @@ get_filename_component(_GCOV_FILENAME_WEXT ${_GCOV_FILENAME} NAME) # #path#to#project#root#subdir#the_file.c.gcov -> /path/to/project/root/subdir/the_file.c - string(REGEX REPLACE "\\.gcov$" "" SRC_FILENAME_TMP ${_GCOV_FILENAME_WEXT}) - string(REGEX REPLACE "\#" "/" SRC_FILENAME_TMP ${SRC_FILENAME_TMP}) + string(REGEX REPLACE "\\.gcov$" "" SRC_FILENAME_TMP "${_GCOV_FILENAME_WEXT}") + string(REGEX REPLACE "\#" "/" SRC_FILENAME_TMP "${SRC_FILENAME_TMP}") set(${_SRC_FILENAME} "${SRC_FILENAME_TMP}") endmacro() @@ -372,7 +372,7 @@ # Advanced way of removing the trailing comma in the JSON array. # "[1, 2, 3, " -> "[1, 2, 3" - string(REGEX REPLACE ",[ ]*$" "" GCOV_FILE_COVERAGE ${GCOV_FILE_COVERAGE}) + string(REGEX REPLACE ",[ ]*$" "" GCOV_FILE_COVERAGE "${GCOV_FILE_COVERAGE}") # Append the trailing ] to complete the JSON array. set(GCOV_FILE_COVERAGE "${GCOV_FILE_COVERAGE}]") @@ -406,7 +406,7 @@ endforeach() # Remove trailing comma, and complete JSON array with ] - string(REGEX REPLACE ",[ ]*$" "" GCOV_FILE_COVERAGE ${GCOV_FILE_COVERAGE}) + string(REGEX REPLACE ",[ ]*$" "" GCOV_FILE_COVERAGE "${GCOV_FILE_COVERAGE}") set(GCOV_FILE_COVERAGE "${GCOV_FILE_COVERAGE}]") # Generate the final JSON for this file. @@ -416,7 +416,7 @@ endforeach() # Get rid of trailing comma. -string(REGEX REPLACE ",[ ]*$" "" JSON_GCOV_FILES ${JSON_GCOV_FILES}) +string(REGEX REPLACE ",[ ]*$" "" JSON_GCOV_FILES "${JSON_GCOV_FILES}") set(JSON_GCOV_FILES "${JSON_GCOV_FILES}]") # Generate the final complete JSON! diff -Nru arpack-3.7.0/CMakeLists.txt arpack-3.8.0/CMakeLists.txt --- arpack-3.7.0/CMakeLists.txt 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/CMakeLists.txt 2020-12-07 10:40:45.000000000 +0000 @@ -6,6 +6,11 @@ project(arpack C Fortran) +set(arpack_ng_MAJOR_VERSION 3) +set(arpack_ng_MINOR_VERSION 8) +set(arpack_ng_PATCH_VERSION 0) +set(arpack_ng_VERSION ${arpack_ng_MAJOR_VERSION}.${arpack_ng_MINOR_VERSION}.${arpack_ng_PATCH_VERSION}) + set(CMAKE_MODULE_PATH ${CMAKE_MODULE_PATH} ${PROJECT_SOURCE_DIR}/cmake) # Adopted from https://github.com/feymark/arpack.git @@ -15,11 +20,12 @@ cmake_policy (SET CMP0042 NEW) endif () +option(BUILD_SHARED_LIBS "Build shared libraries instead of static libraries" ON) option(MPI "Enable parallel support" OFF) option(ICB "Enable support for *[ae]upd_c with ISO_C_BINDING" OFF) option(ICBEXMM "Enable support for matrix market example based on ICB" OFF) -#option(SYSTEM_BLAS "Use system BLAS" ON) -#option(SYSTEM_LAPACK "Use system LAPACK" ON) +option(PYTHON3 "Enable python3 support" OFF) +set(BOOST_PYTHON_LIBSUFFIX "" CACHE STRING "suffix to add to custom boost python libs") option(EXAMPLES "Compile ARPACK examples" OFF) set(LIBSUFFIX "" CACHE STRING "suffix to add to ARPACK libraries names") @@ -29,13 +35,15 @@ set(CMAKE_LIBRARY_OUTPUT_DIRECTORY ${CMAKE_BINARY_DIR}/lib) +# We don't want this to run on every build. +option(COVERALLS "Generate coveralls data" OFF) if (COVERALLS) include(Coveralls) set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -g -O0 -fprofile-arcs -ftest-coverage") set(CMAKE_C_FLAGS "${CMAKE_C_FLAGS} -g -O0 -fprofile-arcs -ftest-coverage") set(CMAKE_CXX_FLAGS "${CMAKE_CXX_FLAGS} -g -O0 -fprofile-arcs -ftest-coverage") # The no space is by design: issue in cmake. See CMP0004. - set(EXTRA_LDLAGS "${EXTRA_LDLAGS}-lgcov") + set(EXTRA_LDFLAGS "${EXTRA_LDFLAGS}-lgcov") endif() function(prefixlist list_name prefix) @@ -50,8 +58,8 @@ foreach(l ${${list_name}}) get_filename_component(lwe ${l} NAME_WE) add_executable(${lwe} ${arpackexample_DIR}/${l} ${examples_EXTRA_SRCS}) - target_link_libraries(${lwe} arpack ${BLAS_LIBRARIES} ${LAPACK_LIBRARIES} ${EXTRA_LDLAGS}) - add_test(NAME "${lwe}_ex" COMMAND ${lwe} WORKING_DIRECTORY ${arpackexample_DIR}) + target_link_libraries(${lwe} arpack BLAS::BLAS LAPACK::LAPACK ${EXTRA_LDFLAGS}) + add_test(NAME "${lwe}_ex" COMMAND ${lwe} WORKING_DIRECTORY ${CMAKE_RUNTIME_OUTPUT_DIRECTORY}) endforeach() endfunction(examples) @@ -59,35 +67,66 @@ foreach(l ${${list_name}}) get_filename_component(lwe ${l} NAME_WE) add_executable(${lwe} ${parpackexample_DIR}/${l} ) - target_link_libraries(${lwe} parpack arpack ${MPI_Fortran_LIBRARIES}) + target_link_libraries(${lwe} parpack arpack MPI::MPI_Fortran) + add_test(NAME "${lwe}_ex" COMMAND mpirun -n 2 ./${lwe} WORKING_DIRECTORY ${CMAKE_RUNTIME_OUTPUT_DIRECTORY}) endforeach() endfunction(pexamples) +if (PYTHON3) + find_package(PythonInterp 3 REQUIRED) + find_package(PythonLibs 3 REQUIRED) + find_package(Boost COMPONENTS python${BOOST_PYTHON_LIBSUFFIX} numpy${BOOST_PYTHON_LIBSUFFIX} REQUIRED) + + set(ICBEXMM "ON") +endif () + if (ICBEXMM) - find_package(Eigen3) - if (NOT Eigen3_FOUND) # If not found, piggy-back pkg-config files. + find_package(Eigen3 3.3 QUIET) + if (NOT EIGEN3_FOUND) # If not found, piggy-back pkg-config files. message(WARNING "CMake didn't find the Eigen3 package. Try to look for pkg-config file...") - find_package(PkgConfig 3.2 REQUIRED) - pkg_check_modules(EIGEN3 REQUIRED eigen3>=3.2) + find_package(PkgConfig REQUIRED) + pkg_check_modules(EIGEN3 REQUIRED eigen3>=3.3) + set(EIGEN3_INCLUDE_DIR ${EIGEN3_INCLUDE_DIRS}) endif () + find_program (BASH_PROGRAM bash) # Look for headers. - find_path(EIGEN3_SPARSE_DIR NAMES Sparse PATHS ${EIGEN3_INCLUDE_DIRS} PATH_SUFFIXES Eigen) - if (NOT EIGEN3_SPARSE_DIR) - message(FATAL_ERROR "-- Eigen/Sparse header not found.") - endif () - find_path(EIGEN3_ITERATIVE_SOLVER_DIR NAMES IterativeLinearSolvers PATHS ${EIGEN3_INCLUDE_DIRS} PATH_SUFFIXES Eigen) + find_path(EIGEN3_ITERATIVE_SOLVER_DIR NAMES IterativeLinearSolvers PATHS ${EIGEN3_INCLUDE_DIR} PATH_SUFFIXES Eigen) if (NOT EIGEN3_ITERATIVE_SOLVER_DIR) message(FATAL_ERROR "-- Eigen/IterativeLinearSolvers header not found.") endif () - find_path(EIGEN3_SLU_SOLVER_DIR NAMES SparseLU PATHS ${EIGEN3_INCLUDE_DIRS} PATH_SUFFIXES Eigen) - if (NOT EIGEN3_SLU_SOLVER_DIR) + find_path(EIGEN3_SPARSE_DIR NAMES Sparse PATHS ${EIGEN3_INCLUDE_DIR} PATH_SUFFIXES Eigen) + if (NOT EIGEN3_SPARSE_DIR) + message(FATAL_ERROR "-- Eigen/Sparse header not found.") + endif () + find_path(EIGEN3_SPARSELU_SOLVER_DIR NAMES SparseLU PATHS ${EIGEN3_INCLUDE_DIR} PATH_SUFFIXES Eigen) + if (NOT EIGEN3_SPARSELU_SOLVER_DIR) message(FATAL_ERROR "-- Eigen/SparseLU header not found.") endif () - find_path(EIGEN3_SQR_SOLVER_DIR NAMES SparseQR PATHS ${EIGEN3_INCLUDE_DIRS} PATH_SUFFIXES Eigen) - if (NOT EIGEN3_SQR_SOLVER_DIR) + find_path(EIGEN3_SPARSEQR_SOLVER_DIR NAMES SparseQR PATHS ${EIGEN3_INCLUDE_DIR} PATH_SUFFIXES Eigen) + if (NOT EIGEN3_SPARSEQR_SOLVER_DIR) message(FATAL_ERROR "-- Eigen/SparseQR header not found.") endif () + find_path(EIGEN3_SPARSECHOLESKY_SOLVER_DIR NAMES SparseCholesky PATHS ${EIGEN3_INCLUDE_DIR} PATH_SUFFIXES Eigen) + if (NOT EIGEN3_SPARSECHOLESKY_SOLVER_DIR) + message(FATAL_ERROR "-- Eigen/SparseCholesky header not found.") + endif () + find_path(EIGEN3_DENSE_DIR NAMES Dense PATHS ${EIGEN3_INCLUDE_DIR} PATH_SUFFIXES Eigen) + if (NOT EIGEN3_DENSE_DIR) + message(FATAL_ERROR "-- Eigen/Dense header not found.") + endif () + find_path(EIGEN3_DENSELU_DIR NAMES LU PATHS ${EIGEN3_INCLUDE_DIR} PATH_SUFFIXES Eigen) + if (NOT EIGEN3_DENSELU_DIR) + message(FATAL_ERROR "-- Eigen/LU header not found.") + endif () + find_path(EIGEN3_DENSEQR_DIR NAMES QR PATHS ${EIGEN3_INCLUDE_DIR} PATH_SUFFIXES Eigen) + if (NOT EIGEN3_DENSEQR_DIR) + message(FATAL_ERROR "-- Eigen/QR header not found.") + endif () + find_path(EIGEN3_DENSECHOLESKY_DIR NAMES Cholesky PATHS ${EIGEN3_INCLUDE_DIR} PATH_SUFFIXES Eigen) + if (NOT EIGEN3_DENSECHOLESKY_DIR) + message(FATAL_ERROR "-- Eigen/Cholesky header not found.") + endif () set(ICB "ON") endif () @@ -165,55 +204,81 @@ FortranCInterface_VERIFY() endif () -#if (SYSTEM_BLAS) +if (NOT TARGET BLAS::BLAS) # Search only if not already found by upper CMakeLists.txt find_package(BLAS REQUIRED) -#endif() -#if (BLAS_LIBRARIES) -# set(SYSTEM_BLAS ON) -#endif() + + # BLAS::BLAS target was already created at this point by FindBLAS.cmake if cmake version >= 3.18 + if (NOT TARGET BLAS::BLAS) # Create target "at hand" to ensure compatibility if cmake version < 3.18 + add_library(BLAS::BLAS INTERFACE IMPORTED) + set_target_properties(BLAS::BLAS PROPERTIES INTERFACE_LINK_LIBRARIES "${BLAS_LIBRARIES}") + endif() +endif() +get_target_property(BLAS_LIBRARIES BLAS::BLAS INTERFACE_LINK_LIBRARIES) # Get variables from target (*.pc/cmake, msg). if (MPI) - include(FindMPI) - find_package(MPI REQUIRED) - include_directories(${MPI_Fortran_INCLUDE_PATH}) + if (NOT TARGET MPI::MPI_Fortran) # Search only if not already found by upper CMakeLists.txt + include(FindMPI) + find_package(MPI REQUIRED) + + # MPI::MPI_* target was already created at this point by FindMPI.cmake if cmake version >= 3.9 + if (NOT TARGET MPI::MPI_Fortran) # Create target "at hand" to ensure compatibility if cmake version < 3.9 + add_library(MPI::MPI_Fortran INTERFACE IMPORTED) + set_target_properties(MPI::MPI_Fortran PROPERTIES INTERFACE_INCLUDE_DIRECTORIES "${MPI_Fortran_INCLUDE_DIRS}") + set_target_properties(MPI::MPI_Fortran PROPERTIES INTERFACE_LINK_LIBRARIES "${MPI_Fortran_LIBRARIES}") + endif() + if (NOT TARGET MPI::MPI_C) # Create target "at hand" to ensure compatibility if cmake version < 3.9 + add_library(MPI::MPI_C INTERFACE IMPORTED) + set_target_properties(MPI::MPI_C PROPERTIES INTERFACE_INCLUDE_DIRECTORIES "${MPI_C_INCLUDE_DIRS}") + set_target_properties(MPI::MPI_C PROPERTIES INTERFACE_LINK_LIBRARIES "${MPI_C_LIBRARIES}") + endif() + if (NOT TARGET MPI::MPI_CXX) # Create target "at hand" to ensure compatibility if cmake version < 3.9 + add_library(MPI::MPI_CXX INTERFACE IMPORTED) + set_target_properties(MPI::MPI_CXX PROPERTIES INTERFACE_INCLUDE_DIRECTORIES "${MPI_CXX_INCLUDE_DIRS}") + set_target_properties(MPI::MPI_CXX PROPERTIES INTERFACE_LINK_LIBRARIES "${MPI_CXX_LIBRARIES}") + endif() + endif() + get_target_property(MPI_Fortran_INCLUDE_DIRS MPI::MPI_Fortran INTERFACE_INCLUDE_DIRECTORIES) # Get variables from target (*.pc/cmake, msg). + get_target_property(MPI_Fortran_LIBRARIES MPI::MPI_Fortran INTERFACE_LINK_LIBRARIES) # Get variables from target (*.pc/cmake, msg). + set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} ${MPI_Fortran_COMPILE_FLAG}") if(ICB) - include_directories(${MPI_C_INCLUDE_PATH}) - include_directories(${MPI_CXX_INCLUDE_PATH}) - check_symbol_exists(MPI_Comm_c2f "${MPI_C_INCLUDE_PATH}/mpi.h" MPI_Comm_c2f_FOUND) + get_target_property(MPI_C_INCLUDE_DIRS MPI::MPI_C INTERFACE_INCLUDE_DIRECTORIES) # Get variables from target (*.pc/cmake, msg). + get_target_property(MPI_C_LIBRARIES MPI::MPI_C INTERFACE_LINK_LIBRARIES) # Get variables from target (*.pc/cmake, msg). + get_target_property(MPI_CXX_INCLUDE_DIRS MPI::MPI_CXX INTERFACE_INCLUDE_DIRECTORIES) # Get variables from target (*.pc/cmake, msg). + get_target_property(MPI_CXX_LIBRARIES MPI::MPI_CXX INTERFACE_LINK_LIBRARIES) # Get variables from target (*.pc/cmake, msg). + + include(CheckSymbolExists) + check_symbol_exists(MPI_Comm_c2f "${MPI_C_INCLUDE_DIRS}/mpi.h" MPI_Comm_c2f_FOUND) if(NOT ${MPI_Comm_c2f_FOUND}) message(FATAL_ERROR "symbol MPI_Comm_c2f does not exist") endif() endif() endif() -#if (SYSTEM_LAPACK) +if (NOT TARGET LAPACK::LAPACK) # Search only if not already found by upper CMakeLists.txt find_package(LAPACK REQUIRED) -#endif() -#if (BLAS_LIBRARIES) -# set(SYSTEM_LAPACK ON) -#endif() + + # LAPACK::LAPACK target was already created at this point by FindLAPACK.cmake if cmake version >= 3.18 + if (NOT TARGET LAPACK::LAPACK) # Create target "at hand" to ensure compatibility if cmake version < 3.18 + add_library(LAPACK::LAPACK INTERFACE IMPORTED) + set_target_properties(LAPACK::LAPACK PROPERTIES INTERFACE_LINK_LIBRARIES "${LAPACK_LIBRARIES}") + endif() +endif() +get_target_property(LAPACK_LIBRARIES LAPACK::LAPACK INTERFACE_LINK_LIBRARIES) # Get variables from target (*.pc/cmake, msg). if (MPI) set(parpackutil_DIR ${arpack_SOURCE_DIR}/PARPACK/UTIL/) set(parpacksrc_DIR ${arpack_SOURCE_DIR}/PARPACK/SRC/) endif() -#if (NOT SYSTEM_BLAS) -# file(GLOB arpackblas_STAT_SRCS blas/*.f) -#endif() -#if (NOT SYSTEM_LAPACK) -# file(GLOB arpacklapack_STAT_SRCS lapack/*.f) -#endif() -#file(GLOB arpackutil_STAT_SRCS util/*.f) -file(GLOB arpacksrc_STAT_SRCS dbgini.f staini.f ${arpack_SOURCE_DIR}/SRC/*.f) +file(GLOB arpacksrc_STAT_SRCS ${arpack_SOURCE_DIR}/dbgini.f ${arpack_SOURCE_DIR}/staini.f ${arpack_SOURCE_DIR}/SRC/*.f) set(arpacksrc_ICB "") set(parpacksrc_ICB "") if(ICB) - file(GLOB arpacksrc_ICB SRC/icba*.F90 ICB/debug_icb.F90 ICB/stat_icb.F90) - file(GLOB parpacksrc_ICB PARPACK/SRC/MPI/icbp*.F90 ICB/debug_icb.F90 ICB/stat_icb.F90) + file(GLOB arpacksrc_ICB ${arpack_SOURCE_DIR}/SRC/icba*.F90 ${arpack_SOURCE_DIR}/ICB/debug_icb.F90 ${arpack_SOURCE_DIR}/ICB/stat_icb.F90) + file(GLOB parpacksrc_ICB ${arpack_SOURCE_DIR}/PARPACK/SRC/MPI/icbp*.F90 ${arpack_SOURCE_DIR}/ICB/debug_icb.F90 ${arpack_SOURCE_DIR}/ICB/stat_icb.F90) endif() set(arpackutil_STAT_SRCS @@ -234,36 +299,15 @@ if (MPI) - file(GLOB parpackutil_STAT_SRCS PARPACK/UTIL/MPI/*.f) - file(GLOB parpacksrc_STAT_SRCS dbgini.f staini.f PARPACK/SRC/MPI/*.f) + file(GLOB parpackutil_STAT_SRCS ${arpack_SOURCE_DIR}/PARPACK/UTIL/MPI/*.f) + file(GLOB parpacksrc_STAT_SRCS ${arpack_SOURCE_DIR}/dbgini.f ${arpack_SOURCE_DIR}/staini.f ${arpack_SOURCE_DIR}/PARPACK/SRC/MPI/*.f) endif() # use -DBUILD_SHARED_LIBS=ON|OFF to control static/shared add_library(arpack ${arpackutil_STAT_SRCS} ${arpacksrc_STAT_SRCS} ${arpacksrc_ICB}) -if(ICB) - install(FILES ICB/arpack.h DESTINATION include/arpack) - install(FILES ICB/arpack.hpp DESTINATION include/arpack) - if (MPI) - install(FILES ICB/parpack.h DESTINATION include/arpack) - install(FILES ICB/parpack.hpp DESTINATION include/arpack) - endif() -endif() - -install(FILES debug.h DESTINATION include/arpack) -if(ICB) - install(FILES ICB/debug_c.h DESTINATION include/arpack) - install(FILES ICB/debug_c.hpp DESTINATION include/arpack) -endif() - -install(FILES stat.h DESTINATION include/arpack) -if(ICB) - install(FILES ICB/stat_c.h DESTINATION include/arpack) - install(FILES ICB/stat_c.hpp DESTINATION include/arpack) -endif() - -target_link_libraries(arpack ${BLAS_LIBRARIES}) -target_link_libraries(arpack ${LAPACK_LIBRARIES} ${EXTRA_LDLAGS}) +target_link_libraries(arpack BLAS::BLAS) +target_link_libraries(arpack LAPACK::LAPACK ${EXTRA_LDFLAGS}) set_target_properties(arpack PROPERTIES OUTPUT_NAME arpack${LIBSUFFIX}) set_target_properties(arpack PROPERTIES VERSION 2.1.0) set_target_properties(arpack PROPERTIES SOVERSION 2) @@ -272,21 +316,16 @@ # use -DBUILD_SHARED_LIBS=ON|OFF to control static/shared add_library(parpack ${parpacksrc_STAT_SRCS} ${parpackutil_STAT_SRCS} ${parpacksrc_ICB}) - if (ICB) - target_include_directories(parpack PUBLIC ${MPI_C_INCLUDE_DIRS}) - target_include_directories(parpack PUBLIC ${MPI_CXX_INCLUDE_DIRS}) - target_link_libraries(parpack ${MPI_C_LIBRARIES}) - target_link_libraries(parpack ${MPI_CXX_LIBRARIES}) - endif() - target_include_directories(parpack PUBLIC ${MPI_Fortran_INCLUDE_DIRS}) - target_link_libraries(parpack ${MPI_Fortran_LIBRARIES}) + target_link_libraries(parpack MPI::MPI_Fortran) target_link_libraries(parpack arpack) set_target_properties(parpack PROPERTIES OUTPUT_NAME parpack${LIBSUFFIX}) set_target_properties(parpack PROPERTIES VERSION 2.1.0) set_target_properties(parpack PROPERTIES SOVERSION 2) endif () +set(PYINT "int32" CACHE STRING "int type to be used in python scripts") # PYINT : int used with python. if (INTERFACE64) + set(PYINT "int64" CACHE STRING "int type to be used in python scripts") # PYINT : int used with python. set(INTERFACE64 1) if ("${CMAKE_Fortran_COMPILER_ID}" MATCHES "GNU") set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -fdefault-integer-8") @@ -299,11 +338,7 @@ set(INTERFACE64 0) endif () -message("-- Generating arpackdef.h") -configure_file(arpackdef.h.in "${PROJECT_BINARY_DIR}/arpackdef.h" @ONLY) -include_directories("${PROJECT_BINARY_DIR}") # Find arpackdef.h -install(FILES "${PROJECT_BINARY_DIR}/arpackdef.h" DESTINATION include/arpack) - +include_directories("${PROJECT_BINARY_DIR}") # Find arpackdef.h and arpackicb.h set(CMAKE_INCLUDE_CURRENT_DIR ON) ############################ @@ -314,7 +349,7 @@ # EXAMPLES/BAND ############################ set(arpackexample_DIR ${arpack_SOURCE_DIR}/EXAMPLES/BAND/) - set(CMAKE_RUNTIME_OUTPUT_DIRECTORY ${CMAKE_BINARY_DIR}/Examples/band/) + set(CMAKE_RUNTIME_OUTPUT_DIRECTORY ${CMAKE_BINARY_DIR}/EXAMPLES/BAND/) set(examples_EXTRA_SRCS ${arpackexample_DIR}/cnband.f) set(examples_STAT_SRCS @@ -377,7 +412,7 @@ # EXAMPLES/COMPLEX ############################ set(arpackexample_DIR ${arpack_SOURCE_DIR}/EXAMPLES/COMPLEX/) - set(CMAKE_RUNTIME_OUTPUT_DIRECTORY ${CMAKE_BINARY_DIR}/Examples/complex/) + set(CMAKE_RUNTIME_OUTPUT_DIRECTORY ${CMAKE_BINARY_DIR}/EXAMPLES/COMPLEX/) set(examples_STAT_SRCS cndrv1.f @@ -394,7 +429,7 @@ # examples/nonsym ############################ set(arpackexample_DIR ${arpack_SOURCE_DIR}/EXAMPLES/NONSYM/) - set(CMAKE_RUNTIME_OUTPUT_DIRECTORY ${CMAKE_BINARY_DIR}/Examples/nonsym/) + set(CMAKE_RUNTIME_OUTPUT_DIRECTORY ${CMAKE_BINARY_DIR}/EXAMPLES/NONSYM/) set(examples_STAT_SRCS dndrv1.f @@ -415,7 +450,7 @@ # examples/SIMPLE ############################ set(arpackexample_DIR ${arpack_SOURCE_DIR}/EXAMPLES/SIMPLE/) - set(CMAKE_RUNTIME_OUTPUT_DIRECTORY ${CMAKE_BINARY_DIR}/Examples/simple/) + set(CMAKE_RUNTIME_OUTPUT_DIRECTORY ${CMAKE_BINARY_DIR}/EXAMPLES/SIMPLE/) set(examples_STAT_SRCS cnsimp.f @@ -431,7 +466,7 @@ # examples/svd ############################ set(arpackexample_DIR ${arpack_SOURCE_DIR}/EXAMPLES/SVD/) - set(CMAKE_RUNTIME_OUTPUT_DIRECTORY ${CMAKE_BINARY_DIR}/Examples/svd/) + set(CMAKE_RUNTIME_OUTPUT_DIRECTORY ${CMAKE_BINARY_DIR}/EXAMPLES/SVD/) set(examples_STAT_SRCS ssvd.f) @@ -442,7 +477,7 @@ # examples/sym ############################ set(arpackexample_DIR ${arpack_SOURCE_DIR}/EXAMPLES/SYM/) - set(CMAKE_RUNTIME_OUTPUT_DIRECTORY ${CMAKE_BINARY_DIR}/Examples/sym/) + set(CMAKE_RUNTIME_OUTPUT_DIRECTORY ${CMAKE_BINARY_DIR}/EXAMPLES/SYM/) set(examples_STAT_SRCS dsdrv1.f @@ -465,7 +500,7 @@ ############################ if (MPI) set(parpackexample_DIR ${arpack_SOURCE_DIR}/PARPACK/EXAMPLES/MPI/) - set(CMAKE_RUNTIME_OUTPUT_DIRECTORY ${CMAKE_BINARY_DIR}/Examples/parpack) + set(CMAKE_RUNTIME_OUTPUT_DIRECTORY ${CMAKE_BINARY_DIR}/PARPACK/EXAMPLES/MPI/) set(pexamples_STAT_SRCS pcndrv1.f @@ -490,86 +525,150 @@ set(CMAKE_CTEST_COMMAND ctest -V) -set(CMAKE_RUNTIME_OUTPUT_DIRECTORY ${CMAKE_BINARY_DIR}/Tests) +set(CMAKE_RUNTIME_OUTPUT_DIRECTORY ${CMAKE_BINARY_DIR}/TESTS) add_executable(dnsimp_test TESTS/dnsimp.f TESTS/mmio.f TESTS/debug.h) set_target_properties( dnsimp_test PROPERTIES OUTPUT_NAME dnsimp ) -target_link_libraries(dnsimp_test arpack ${BLAS_LIBRARIES} ${LAPACK_LIBRARIES} ${EXTRA_LDLAGS}) +target_link_libraries(dnsimp_test arpack BLAS::BLAS LAPACK::LAPACK ${EXTRA_LDFLAGS}) add_custom_command(TARGET dnsimp_test POST_BUILD COMMAND ${CMAKE_COMMAND} -E copy ${CMAKE_CURRENT_SOURCE_DIR}/TESTS/testA.mtx testA.mtx ) -add_test(dnsimp_tst Tests/dnsimp) +add_test(dnsimp_tst ${CMAKE_RUNTIME_OUTPUT_DIRECTORY}/dnsimp) if (NOT ICB) add_executable(bug_1315_single TESTS/bug_1315_single.c) - target_link_libraries(bug_1315_single arpack ${BLAS_LIBRARIES} ${LAPACK_LIBRARIES} ${EXTRA_LDLAGS}) - add_test(bug_1315_single_tst Tests/bug_1315_single) + target_link_libraries(bug_1315_single arpack BLAS::BLAS LAPACK::LAPACK ${EXTRA_LDFLAGS}) + add_test(bug_1315_single_tst ${CMAKE_RUNTIME_OUTPUT_DIRECTORY}/bug_1315_single) add_executable(bug_1315_double TESTS/bug_1315_double.c) - target_link_libraries(bug_1315_double arpack ${BLAS_LIBRARIES} ${LAPACK_LIBRARIES} ${EXTRA_LDLAGS}) - add_test(bug_1315_double_tst Tests/bug_1315_double) + target_link_libraries(bug_1315_double arpack BLAS::BLAS LAPACK::LAPACK ${EXTRA_LDFLAGS}) + add_test(bug_1315_double_tst ${CMAKE_RUNTIME_OUTPUT_DIRECTORY}/bug_1315_double) endif() add_executable(bug_1323 TESTS/bug_1323.f) -target_link_libraries(bug_1323 arpack ${BLAS_LIBRARIES} ${LAPACK_LIBRARIES} ${EXTRA_LDLAGS}) -add_test(bug_1323_tst Tests/bug_1323) +target_link_libraries(bug_1323 arpack BLAS::BLAS LAPACK::LAPACK ${EXTRA_LDFLAGS}) +add_test(bug_1323_tst ${CMAKE_RUNTIME_OUTPUT_DIRECTORY}/bug_1323) add_executable(bug_58_double TESTS/bug_58_double.f) -target_link_libraries(bug_58_double arpack ${BLAS_LIBRARIES} ${LAPACK_LIBRARIES} ${EXTRA_LDLAGS}) -add_test(bug_58_double_tst Tests/bug_58_double) +target_link_libraries(bug_58_double arpack BLAS::BLAS LAPACK::LAPACK ${EXTRA_LDFLAGS}) +add_test(bug_58_double_tst ${CMAKE_RUNTIME_OUTPUT_DIRECTORY}/bug_58_double) add_executable(bug_79_double_complex TESTS/bug_79_double_complex.f) -target_link_libraries(bug_79_double_complex arpack ${BLAS_LIBRARIES} ${LAPACK_LIBRARIES} ${EXTRA_LDLAGS}) -add_test(bug_79_double_complex_tst Tests/bug_79_double_complex) +target_link_libraries(bug_79_double_complex arpack BLAS::BLAS LAPACK::LAPACK ${EXTRA_LDFLAGS}) +add_test(bug_79_double_complex_tst ${CMAKE_RUNTIME_OUTPUT_DIRECTORY}/bug_79_double_complex) add_executable(bug_142 TESTS/bug_142.f) -target_link_libraries(bug_142 arpack ${BLAS_LIBRARIES} ${LAPACK_LIBRARIES} ${EXTRA_LDLAGS}) -add_test(bug_142_tst Tests/bug_142) +target_link_libraries(bug_142 arpack BLAS::BLAS LAPACK::LAPACK ${EXTRA_LDFLAGS}) +add_test(bug_142_tst ${CMAKE_RUNTIME_OUTPUT_DIRECTORY}/bug_142) add_executable(bug_142_gen TESTS/bug_142_gen.f) -target_link_libraries(bug_142_gen arpack ${BLAS_LIBRARIES} ${LAPACK_LIBRARIES} ${EXTRA_LDLAGS}) -add_test(bug_142_gen_tst Tests/bug_142_gen) +target_link_libraries(bug_142_gen arpack BLAS::BLAS LAPACK::LAPACK ${EXTRA_LDFLAGS}) +add_test(bug_142_gen_tst ${CMAKE_RUNTIME_OUTPUT_DIRECTORY}/bug_142_gen) if(MPI) + set(CMAKE_RUNTIME_OUTPUT_DIRECTORY ${CMAKE_BINARY_DIR}/PARPACK/TESTS/MPI) + add_executable(issue46 PARPACK/TESTS/MPI/issue46.f) - target_link_libraries(issue46 parpack arpack ${BLAS_LIBRARIES} ${LAPACK_LIBRARIES} ${EXTRA_LDLAGS}) - add_test(issue46_tst Tests/issue46) + target_link_libraries(issue46 parpack arpack BLAS::BLAS LAPACK::LAPACK ${EXTRA_LDFLAGS}) + add_test(issue46_tst ${CMAKE_RUNTIME_OUTPUT_DIRECTORY}/issue46) endif() if(ICB) + set(CMAKE_RUNTIME_OUTPUT_DIRECTORY ${CMAKE_BINARY_DIR}/TESTS) + add_executable(icb_arpack_c TESTS/icb_arpack_c.c) target_include_directories(icb_arpack_c PUBLIC ${PROJECT_SOURCE_DIR}/ICB) # Get arpack.h - target_link_libraries(icb_arpack_c arpack ${BLAS_LIBRARIES} ${LAPACK_LIBRARIES} ${EXTRA_LDLAGS}) - add_test(icb_arpack_c_tst Tests/icb_arpack_c) + target_link_libraries(icb_arpack_c arpack BLAS::BLAS LAPACK::LAPACK ${EXTRA_LDFLAGS}) + add_test(icb_arpack_c_tst ${CMAKE_RUNTIME_OUTPUT_DIRECTORY}/icb_arpack_c) add_executable(icb_arpack_cpp TESTS/icb_arpack_cpp.cpp) target_include_directories(icb_arpack_cpp PUBLIC ${PROJECT_SOURCE_DIR}/ICB) # Get arpack.hpp - target_link_libraries(icb_arpack_cpp arpack ${BLAS_LIBRARIES} ${LAPACK_LIBRARIES} ${EXTRA_LDLAGS}) - add_test(icb_arpack_cpp_tst Tests/icb_arpack_cpp) + target_link_libraries(icb_arpack_cpp arpack BLAS::BLAS LAPACK::LAPACK ${EXTRA_LDFLAGS}) + add_test(icb_arpack_cpp_tst ${CMAKE_RUNTIME_OUTPUT_DIRECTORY}/icb_arpack_cpp) if (ICBEXMM) + set(CMAKE_RUNTIME_OUTPUT_DIRECTORY ${CMAKE_BINARY_DIR}/EXAMPLES/MATRIX_MARKET) + add_executable(arpackmm EXAMPLES/MATRIX_MARKET/arpackmm.cpp) - target_include_directories(arpackmm PUBLIC ${PROJECT_SOURCE_DIR}/ICB ${EIGEN3_INCLUDE_DIRS}) # Get arpack.h + eigen - target_link_libraries(arpackmm arpack ${BLAS_LIBRARIES} ${LAPACK_LIBRARIES} ${EXTRA_LDLAGS}) - configure_file(EXAMPLES/MATRIX_MARKET/As.mtx Tests/As.mtx) - configure_file(EXAMPLES/MATRIX_MARKET/An.mtx Tests/An.mtx) - configure_file(EXAMPLES/MATRIX_MARKET/Az.mtx Tests/Az.mtx) - configure_file(EXAMPLES/MATRIX_MARKET/B.mtx Tests/B.mtx) - configure_file(EXAMPLES/MATRIX_MARKET/Bz.mtx Tests/Bz.mtx) - configure_file(EXAMPLES/MATRIX_MARKET/arpackmm.sh Tests/arpackmm.sh) - add_test(NAME arpackmm_tst WORKING_DIRECTORY ${arpack_BINARY_DIR}/Tests COMMAND arpackmm.sh) + target_include_directories(arpackmm PUBLIC ${PROJECT_SOURCE_DIR}/ICB ${EIGEN3_INCLUDE_DIR}) # Get arpack.h + eigen + target_link_libraries(arpackmm arpack BLAS::BLAS LAPACK::LAPACK ${EXTRA_LDFLAGS}) + configure_file(EXAMPLES/MATRIX_MARKET/As.mtx ${CMAKE_RUNTIME_OUTPUT_DIRECTORY}/As.mtx) + configure_file(EXAMPLES/MATRIX_MARKET/An.mtx ${CMAKE_RUNTIME_OUTPUT_DIRECTORY}/An.mtx) + configure_file(EXAMPLES/MATRIX_MARKET/Az.mtx ${CMAKE_RUNTIME_OUTPUT_DIRECTORY}/Az.mtx) + configure_file(EXAMPLES/MATRIX_MARKET/B.mtx ${CMAKE_RUNTIME_OUTPUT_DIRECTORY}/B.mtx) + configure_file(EXAMPLES/MATRIX_MARKET/Bz.mtx ${CMAKE_RUNTIME_OUTPUT_DIRECTORY}/Bz.mtx) + configure_file(EXAMPLES/MATRIX_MARKET/arpackmm.sh ${CMAKE_RUNTIME_OUTPUT_DIRECTORY}/arpackmm.sh) + add_test(NAME arpackmm_tst WORKING_DIRECTORY ${CMAKE_RUNTIME_OUTPUT_DIRECTORY} COMMAND ${BASH_PROGRAM} arpackmm.sh) + endif() + + if (PYTHON3) + python_add_module(pyarpack ${arpackutil_STAT_SRCS} ${arpacksrc_STAT_SRCS} ${arpacksrc_ICB} ${PROJECT_SOURCE_DIR}/EXAMPLES/PYARPACK/pyarpack.cpp) + target_compile_definitions(pyarpack PRIVATE PY_MAJOR_VERSION="3") + set(pyarpack_HDR ${PROJECT_SOURCE_DIR}/ICB ${PROJECT_SOURCE_DIR}/EXAMPLES/MATRIX_MARKET ${PROJECT_SOURCE_DIR}/EXAMPLES/PYARPACK) + target_include_directories(pyarpack PUBLIC ${pyarpack_HDR} ${EIGEN3_INCLUDE_DIR} ${Boost_INCLUDE_DIRS} ${PYTHON_INCLUDE_DIRS}) + target_link_libraries(pyarpack BLAS::BLAS LAPACK::LAPACK ${Boost_LIBRARIES} ${PYTHON_LIBRARIES}) + install(TARGETS pyarpack + ARCHIVE DESTINATION ${CMAKE_INSTALL_LIBDIR}/pyarpack + LIBRARY DESTINATION ${CMAKE_INSTALL_LIBDIR}/pyarpack) + configure_file("${PROJECT_SOURCE_DIR}/EXAMPLES/PYARPACK/pyarpackSparseBiCGDiag.py.in" "${CMAKE_BINARY_DIR}/pyarpackSparseBiCGDiag.py" @ONLY) + add_test(NAME pyarpackSparseBiCGDiag_tst COMMAND ${PYTHON_EXECUTABLE} pyarpackSparseBiCGDiag.py) + set_tests_properties(pyarpackSparseBiCGDiag_tst PROPERTIES ENVIRONMENT PYTHONPATH=${CMAKE_BINARY_DIR}/lib:$ENV{PYTHONPATH}) + configure_file("${PROJECT_SOURCE_DIR}/EXAMPLES/PYARPACK/pyarpackSparseBiCGILU.py.in" "${CMAKE_BINARY_DIR}/pyarpackSparseBiCGILU.py" @ONLY) + add_test(NAME pyarpackSparseBiCGILU_tst COMMAND ${PYTHON_EXECUTABLE} pyarpackSparseBiCGILU.py) + set_tests_properties(pyarpackSparseBiCGILU_tst PROPERTIES ENVIRONMENT PYTHONPATH=${CMAKE_BINARY_DIR}/lib:$ENV{PYTHONPATH}) + configure_file("${PROJECT_SOURCE_DIR}/EXAMPLES/PYARPACK/pyarpackSparseCGDiag.py.in" "${CMAKE_BINARY_DIR}/pyarpackSparseCGDiag.py" @ONLY) + add_test(NAME pyarpackSparseCGDiag_tst COMMAND ${PYTHON_EXECUTABLE} pyarpackSparseCGDiag.py) + set_tests_properties(pyarpackSparseCGDiag_tst PROPERTIES ENVIRONMENT PYTHONPATH=${CMAKE_BINARY_DIR}/lib:$ENV{PYTHONPATH}) + configure_file("${PROJECT_SOURCE_DIR}/EXAMPLES/PYARPACK/pyarpackSparseCGILU.py.in" "${CMAKE_BINARY_DIR}/pyarpackSparseCGILU.py" @ONLY) + add_test(NAME pyarpackSparseCGILU_tst COMMAND ${PYTHON_EXECUTABLE} pyarpackSparseCGILU.py) + set_tests_properties(pyarpackSparseCGILU_tst PROPERTIES ENVIRONMENT PYTHONPATH=${CMAKE_BINARY_DIR}/lib:$ENV{PYTHONPATH}) + configure_file("${PROJECT_SOURCE_DIR}/EXAMPLES/PYARPACK/pyarpackSparseLLT.py.in" "${CMAKE_BINARY_DIR}/pyarpackSparseLLT.py" @ONLY) + add_test(NAME pyarpackSparseLLT_tst COMMAND ${PYTHON_EXECUTABLE} pyarpackSparseLLT.py) + set_tests_properties(pyarpackSparseLLT_tst PROPERTIES ENVIRONMENT PYTHONPATH=${CMAKE_BINARY_DIR}/lib:$ENV{PYTHONPATH}) + configure_file("${PROJECT_SOURCE_DIR}/EXAMPLES/PYARPACK/pyarpackSparseLDLT.py.in" "${CMAKE_BINARY_DIR}/pyarpackSparseLDLT.py" @ONLY) + add_test(NAME pyarpackSparseLDLT_tst COMMAND ${PYTHON_EXECUTABLE} pyarpackSparseLDLT.py) + set_tests_properties(pyarpackSparseLDLT_tst PROPERTIES ENVIRONMENT PYTHONPATH=${CMAKE_BINARY_DIR}/lib:$ENV{PYTHONPATH}) + configure_file("${PROJECT_SOURCE_DIR}/EXAMPLES/PYARPACK/pyarpackSparseLU.py.in" "${CMAKE_BINARY_DIR}/pyarpackSparseLU.py" @ONLY) + add_test(NAME pyarpackSparseLU_tst COMMAND ${PYTHON_EXECUTABLE} pyarpackSparseLU.py) + set_tests_properties(pyarpackSparseLU_tst PROPERTIES ENVIRONMENT PYTHONPATH=${CMAKE_BINARY_DIR}/lib:$ENV{PYTHONPATH}) + configure_file("${PROJECT_SOURCE_DIR}/EXAMPLES/PYARPACK/pyarpackSparseQR.py.in" "${CMAKE_BINARY_DIR}/pyarpackSparseQR.py" @ONLY) + add_test(NAME pyarpackSparseQR_tst COMMAND ${PYTHON_EXECUTABLE} pyarpackSparseQR.py) + set_tests_properties(pyarpackSparseQR_tst PROPERTIES ENVIRONMENT PYTHONPATH=${CMAKE_BINARY_DIR}/lib:$ENV{PYTHONPATH}) + configure_file("${PROJECT_SOURCE_DIR}/EXAMPLES/PYARPACK/pyarpackDenseLLT.py.in" "${CMAKE_BINARY_DIR}/pyarpackDenseLLT.py" @ONLY) + add_test(NAME pyarpackDenseLLT_tst COMMAND ${PYTHON_EXECUTABLE} pyarpackDenseLLT.py) + set_tests_properties(pyarpackDenseLLT_tst PROPERTIES ENVIRONMENT PYTHONPATH=${CMAKE_BINARY_DIR}/lib:$ENV{PYTHONPATH}) + configure_file("${PROJECT_SOURCE_DIR}/EXAMPLES/PYARPACK/pyarpackDenseLDLT.py.in" "${CMAKE_BINARY_DIR}/pyarpackDenseLDLT.py" @ONLY) + add_test(NAME pyarpackDenseLDLT_tst COMMAND ${PYTHON_EXECUTABLE} pyarpackDenseLDLT.py) + set_tests_properties(pyarpackDenseLDLT_tst PROPERTIES ENVIRONMENT PYTHONPATH=${CMAKE_BINARY_DIR}/lib:$ENV{PYTHONPATH}) + configure_file("${PROJECT_SOURCE_DIR}/EXAMPLES/PYARPACK/pyarpackDenseLURR.py.in" "${CMAKE_BINARY_DIR}/pyarpackDenseLURR.py" @ONLY) + add_test(NAME pyarpackDenseLURR_tst COMMAND ${PYTHON_EXECUTABLE} pyarpackDenseLURR.py) + set_tests_properties(pyarpackDenseLURR_tst PROPERTIES ENVIRONMENT PYTHONPATH=${CMAKE_BINARY_DIR}/lib:$ENV{PYTHONPATH}) + configure_file("${PROJECT_SOURCE_DIR}/EXAMPLES/PYARPACK/pyarpackDenseQRRR.py.in" "${CMAKE_BINARY_DIR}/pyarpackDenseQRRR.py" @ONLY) + add_test(NAME pyarpackDenseQRRR_tst COMMAND ${PYTHON_EXECUTABLE} pyarpackDenseQRRR.py) + set_tests_properties(pyarpackDenseQRRR_tst PROPERTIES ENVIRONMENT PYTHONPATH=${CMAKE_BINARY_DIR}/lib:$ENV{PYTHONPATH}) + configure_file("${PROJECT_SOURCE_DIR}/EXAMPLES/PYARPACK/pyarpackDenseLUPP.py.in" "${CMAKE_BINARY_DIR}/pyarpackDenseLUPP.py" @ONLY) + add_test(NAME pyarpackDenseLUPP_tst COMMAND ${PYTHON_EXECUTABLE} pyarpackDenseLUPP.py) + set_tests_properties(pyarpackDenseLUPP_tst PROPERTIES ENVIRONMENT PYTHONPATH=${CMAKE_BINARY_DIR}/lib:$ENV{PYTHONPATH}) + configure_file("${PROJECT_SOURCE_DIR}/EXAMPLES/PYARPACK/pyarpackDenseQRPP.py.in" "${CMAKE_BINARY_DIR}/pyarpackDenseQRPP.py" @ONLY) + add_test(NAME pyarpackDenseQRPP_tst COMMAND ${PYTHON_EXECUTABLE} pyarpackDenseQRPP.py) + set_tests_properties(pyarpackDenseQRPP_tst PROPERTIES ENVIRONMENT PYTHONPATH=${CMAKE_BINARY_DIR}/lib:$ENV{PYTHONPATH}) + configure_file("${PROJECT_SOURCE_DIR}/EXAMPLES/PYARPACK/pyarpackRestart.py.in" "${CMAKE_BINARY_DIR}/pyarpackRestart.py" @ONLY) + add_test(NAME pyarpackRestart_tst COMMAND ${PYTHON_EXECUTABLE} pyarpackRestart.py) + set_tests_properties(pyarpackRestart_tst PROPERTIES ENVIRONMENT PYTHONPATH=${CMAKE_BINARY_DIR}/lib:$ENV{PYTHONPATH}) endif() if (MPI) + set(CMAKE_RUNTIME_OUTPUT_DIRECTORY ${CMAKE_BINARY_DIR}/PARPACK/TESTS/MPI) + add_executable(icb_parpack_c PARPACK/TESTS/MPI/icb_parpack_c.c) - target_include_directories(icb_parpack_c PUBLIC ${PROJECT_SOURCE_DIR}/ICB ${MPI_C_INCLUDE_DIRS}) # Get parpack.h mpi.h - target_link_libraries(icb_parpack_c parpack arpack ${BLAS_LIBRARIES} ${LAPACK_LIBRARIES} ${EXTRA_LDLAGS} ${MPI_C_LIBRARIES}) - add_test(icb_parpack_c_tst mpirun -n 2 Tests/icb_parpack_c) + target_include_directories(icb_parpack_c PUBLIC ${PROJECT_SOURCE_DIR}/ICB MPI::MPI_C) # Get parpack.h mpi.h + target_link_libraries(icb_parpack_c parpack arpack BLAS::BLAS LAPACK::LAPACK ${EXTRA_LDFLAGS} MPI::MPI_C) + add_test(icb_parpack_c_tst mpirun -n 2 ${CMAKE_RUNTIME_OUTPUT_DIRECTORY}/icb_parpack_c) add_executable(icb_parpack_cpp PARPACK/TESTS/MPI/icb_parpack_cpp.cpp) - target_include_directories(icb_parpack_cpp PUBLIC ${PROJECT_SOURCE_DIR}/ICB ${MPI_CXX_INCLUDE_DIRS}) # Get parpack.hpp mpi.h - target_link_libraries(icb_parpack_cpp parpack arpack ${BLAS_LIBRARIES} ${LAPACK_LIBRARIES} ${EXTRA_LDLAGS} ${MPI_CXX_LIBRARIES}) - add_test(icb_parpack_cpp_tst mpirun -n 2 Tests/icb_parpack_cpp) + target_include_directories(icb_parpack_cpp PUBLIC ${PROJECT_SOURCE_DIR}/ICB MPI::MPI_CXX) # Get parpack.hpp mpi.h + target_link_libraries(icb_parpack_cpp parpack arpack BLAS::BLAS LAPACK::LAPACK ${EXTRA_LDFLAGS} MPI::MPI_CXX) + add_test(icb_parpack_cpp_tst mpirun -n 2 ${CMAKE_RUNTIME_OUTPUT_DIRECTORY}/icb_parpack_cpp) endif() endif() @@ -579,27 +678,90 @@ # 'make install' to the correct location include(GNUInstallDirs) +# Convert variable names to those expected by the .pc file. +set(prefix ${CMAKE_INSTALL_PREFIX}) +set(exec_prefix \${prefix}) +set(libdir \${exec_prefix}/${CMAKE_INSTALL_LIBDIR}) +set(includedir \${prefix}/${CMAKE_INSTALL_INCLUDEDIR}) +set(PACKAGE_NAME ${PROJECT_NAME}) +set(PACKAGE_VERSION ${arpack_ng_VERSION}) +set(PACKAGE_URL "https://github.com/opencollab/arpack-ng/") + +# Convert (LAPACK|BLAS)_LIBRARIES to -l flags, store in ARPACK_PC_LIBS_PRIVATE. +# LAPACK_LIBRARIES contains transitive deps, no need to parse BLAS_LIBRARIES. +set(ARPACK_PC_LIBS_PRIVATE) +foreach(lib ${LAPACK_LIBRARIES}) + get_filename_component(libname ${lib} NAME) + string(REGEX REPLACE "^lib([^.]+).*$" "-l\\1" libname ${libname}) + list(APPEND ARPACK_PC_LIBS_PRIVATE "${libname}") +endforeach() +string(REPLACE ";" " " ARPACK_PC_LIBS_PRIVATE "${ARPACK_PC_LIBS_PRIVATE}") + +set(PARPACK_PC_LIBS_PRIVATE) +foreach(lib ${LAPACK_LIBRARIES} ${MPI_Fortran_LIBRARIES}) + get_filename_component(libname ${lib} NAME) + string(REGEX REPLACE "^lib([^.]+).*$" "-l\\1" libname ${libname}) + list(APPEND PARPACK_PC_LIBS_PRIVATE "${libname}") +endforeach() +string(REPLACE ";" " " PARPACK_PC_LIBS_PRIVATE "${PARPACK_PC_LIBS_PRIVATE}") + +configure_file(SRC/arpack.pc.in "${PROJECT_BINARY_DIR}/SRC/arpack${LIBSUFFIX}.pc" @ONLY) +configure_file(PARPACK/SRC/MPI/parpack.pc.in "${PROJECT_BINARY_DIR}/PARPACK/SRC/MPI/parpack${LIBSUFFIX}.pc" @ONLY) +configure_file(EXAMPLES/MATRIX_MARKET/arpackSolver.pc.in "${PROJECT_BINARY_DIR}/EXAMPLES/MATRIX_MARKET/arpackSolver.pc" @ONLY) + + install(TARGETS arpack ARCHIVE DESTINATION ${CMAKE_INSTALL_LIBDIR} LIBRARY DESTINATION ${CMAKE_INSTALL_LIBDIR} RUNTIME DESTINATION ${CMAKE_INSTALL_BINDIR}) +install(FILES "${PROJECT_BINARY_DIR}/SRC/arpack${LIBSUFFIX}.pc" + DESTINATION ${CMAKE_INSTALL_LIBDIR}/pkgconfig) if (MPI) install(TARGETS parpack ARCHIVE DESTINATION ${CMAKE_INSTALL_LIBDIR} LIBRARY DESTINATION ${CMAKE_INSTALL_LIBDIR} RUNTIME DESTINATION ${CMAKE_INSTALL_BINDIR}) + install(FILES "${PROJECT_BINARY_DIR}/PARPACK/SRC/MPI/parpack${LIBSUFFIX}.pc" + DESTINATION ${CMAKE_INSTALL_LIBDIR}/pkgconfig) endif () +if(ICB) + install(FILES ICB/arpack.h DESTINATION ${CMAKE_INSTALL_INCLUDEDIR}/arpack) + install(FILES ICB/arpack.hpp DESTINATION ${CMAKE_INSTALL_INCLUDEDIR}/arpack) + if (MPI) + install(FILES ICB/parpack.h DESTINATION ${CMAKE_INSTALL_INCLUDEDIR}/arpack) + install(FILES ICB/parpack.hpp DESTINATION ${CMAKE_INSTALL_INCLUDEDIR}/arpack) + endif() + if (ICBEXMM) + install(FILES EXAMPLES/MATRIX_MARKET/arpackSolver.hpp DESTINATION ${CMAKE_INSTALL_INCLUDEDIR}/arpack) + install(FILES "${PROJECT_BINARY_DIR}/EXAMPLES/MATRIX_MARKET/arpackSolver.pc" DESTINATION ${CMAKE_INSTALL_LIBDIR}/pkgconfig) + endif() +endif() + +install(FILES debug.h DESTINATION ${CMAKE_INSTALL_INCLUDEDIR}/arpack) +if(ICB) + install(FILES ICB/debug_c.h DESTINATION ${CMAKE_INSTALL_INCLUDEDIR}/arpack) + install(FILES ICB/debug_c.hpp DESTINATION ${CMAKE_INSTALL_INCLUDEDIR}/arpack) +endif() + +install(FILES stat.h DESTINATION ${CMAKE_INSTALL_INCLUDEDIR}/arpack) +if(ICB) + install(FILES ICB/stat_c.h DESTINATION ${CMAKE_INSTALL_INCLUDEDIR}/arpack) + install(FILES ICB/stat_c.hpp DESTINATION ${CMAKE_INSTALL_INCLUDEDIR}/arpack) +endif() + +configure_file(arpackdef.h.in "${PROJECT_BINARY_DIR}/arpackdef.h" @ONLY) +install(FILES "${PROJECT_BINARY_DIR}/arpackdef.h" DESTINATION ${CMAKE_INSTALL_INCLUDEDIR}/arpack) + +configure_file(arpackicb.h.in "${PROJECT_BINARY_DIR}/arpackicb.h" @ONLY) +install(FILES "${PROJECT_BINARY_DIR}/arpackicb.h" DESTINATION ${CMAKE_INSTALL_INCLUDEDIR}/arpack) + # Provide find_package for arpack-ng to users. configure_file(arpack-ng-config.cmake.in "${PROJECT_BINARY_DIR}/arpack-ng-config.cmake" @ONLY) -install(FILES "${PROJECT_BINARY_DIR}/arpack-ng-config.cmake" DESTINATION "${CMAKE_INSTALL_PREFIX}/lib/cmake") # find_package(arpack-ng) -set(arpack_ng_MAJOR_VERSION 3) -set(arpack_ng_MINOR_VERSION 7) -set(arpack_ng_PATCH_VERSION 0) -set(arpack_ng_VERSION ${arpack_ng_MAJOR_VERSION}.${arpack_ng_MINOR_VERSION}.${arpack_ng_PATCH_VERSION}) +install(FILES "${PROJECT_BINARY_DIR}/arpack-ng-config.cmake" DESTINATION ${CMAKE_INSTALL_LIBDIR}/cmake/arpack-ng) # find_package(arpack-ng) configure_file(arpack-ng-config-version.cmake.in "${PROJECT_BINARY_DIR}/arpack-ng-config-version.cmake" @ONLY) -install(FILES "${PROJECT_BINARY_DIR}/arpack-ng-config-version.cmake" DESTINATION "${CMAKE_INSTALL_PREFIX}/lib/cmake") +install(FILES "${PROJECT_BINARY_DIR}/arpack-ng-config-version.cmake" DESTINATION ${CMAKE_INSTALL_LIBDIR}/cmake/arpack-ng) # Packaging: ease arpack-ng distribution (precompiled binaries and sources tarballs). set(CPACK_VERSION_MAJOR "${arpack_ng_MAJOR_VERSION}") @@ -609,33 +771,34 @@ set(CPACK_SOURCE_PACKAGE_FILE_NAME "arpack-ng-${CPACK_VERSION_MAJOR}.${CPACK_VERSION_MINOR}.${CPACK_VERSION_PATCH}") include(CPack) -# Convert variable names to those expected by the .pc file. -set(prefix ${CMAKE_INSTALL_PREFIX}) -set(exec_prefix \${prefix}) -set(libdir \${exec_prefix}/${CMAKE_INSTALL_LIBDIR}) -set(includedir \${prefix}/${CMAKE_INSTALL_INCLUDEDIR}) -set(PACKAGE_NAME ${PROJECT_NAME}) -set(PACKAGE_VERSION ${arpack_ng_VERSION}) -set(PACKAGE_URL "https://github.com/opencollab/arpack-ng/") -# TODO: Fill these in with something appropriate. -#set(LAPACK_LIBS) -#set(BLAS_LIBS) -configure_file(arpack.pc.in arpack${LIBSUFFIX}.pc @ONLY) -#install(FILES ${CMAKE_CURRENT_BINARY_DIR}/arpack${LIBSUFFIX}.pc -# DESTINATION ${CMAKE_INSTALL_LIBDIR}/pkgconfig) - - -# We don't want this to run on every build. -option(COVERALLS "Generate coveralls data" OFF) - - if (COVERALLS) - set(COVERAGE_SRCS awesome.c code.c files.c) + set(arpack_TST_SRC + ${arpack_SOURCE_DIR}/TESTS/bug_1323.f + ${arpack_SOURCE_DIR}/TESTS/bug_142.f + ${arpack_SOURCE_DIR}/TESTS/bug_142_gen.f + ${arpack_SOURCE_DIR}/TESTS/bug_58_double.f + ${arpack_SOURCE_DIR}/TESTS/bug_79_double_complex.f + ${arpack_SOURCE_DIR}/TESTS/dnsimp.f + ${arpack_SOURCE_DIR}/TESTS/mmio.f + ${arpack_SOURCE_DIR}/TESTS/bug_1315_single.c + ${arpack_SOURCE_DIR}/TESTS/bug_1315_double.c + ${arpack_SOURCE_DIR}/TESTS/icb_arpack_c.c + ${arpack_SOURCE_DIR}/TESTS/icb_arpack_cpp.cpp + ) + file(GLOB_RECURSE arpack_EX_F_SRC "${arpack_SOURCE_DIR}/EXAMPLES/*/*.f") + set(arpack_EX_CPP_SRC ${arpack_SOURCE_DIR}/EXAMPLES/MATRIX_MARKET/arpackmm.cpp) + + set(parpack_TST_SRC + ${arpack_SOURCE_DIR}/PARPACK/TESTS/MPI/issue46.f + ${arpack_SOURCE_DIR}/PARPACK/TESTS/MPI/icb_parpack_c.c + ${arpack_SOURCE_DIR}/PARPACK/TESTS/MPI/icb_parpack_cpp.cpp + ) + file(GLOB_RECURSE parpack_EX_F_SRC "${arpack_SOURCE_DIR}/PARPACK/EXAMPLES/MPI/*.f") # Create the coveralls target. # Also lists the c/cpp files for test purposes coveralls_setup( - "${arpackutil_STAT_SRCS} ${arpacksrc_STAT_SRCS} ${arpacksrc_ICB} ${parpacksrc_DIR} ${parpackutil_DIR} ${PROJECT_SOURCE_DIR}/TESTS/icb_arpack_c.c ${PROJECT_SOURCE_DIR}/TESTS/icb_arpack_cpp.cpp" # The source files. + "${arpacksrc_STAT_SRCS} ${arpackutil_STAT_SRCS} ${arpacksrc_ICB} ${arpack_TST_SRC} ${arpack_EX_F_SRC} ${arpack_EX_CPP_SRC} ${parpacksrc_STAT_SRCS} ${parpackutil_STAT_SRCS} ${parpacksrc_ICB} ${parpack_TST_SRC} ${parpack_EX_F_SRC}" # The source files. ON # If we should upload. "${PROJECT_SOURCE_DIR}/cmake/") # (Optional) Alternate project cmake module path. endif() @@ -692,14 +855,19 @@ "${CMAKE_CXX_FLAGS}") endif() if (MPI) - libsummary("MPIFC" "${MPI_Fortran_INCLUDE_PATH}" "${MPI_Fortran_LIBRARIES}") + libsummary("MPIFC" "${MPI_Fortran_INCLUDE_DIRS}" "${MPI_Fortran_LIBRARIES}") if (ICB) - libsummary("MPICC" "${MPI_C_INCLUDE_PATH}" "${MPI_C_LIBRARIES}") - libsummary("MPICXX" "${MPI_CXX_INCLUDE_PATH}" "${MPI_CXX_LIBRARIES}") + libsummary("MPICC" "${MPI_C_INCLUDE_DIRS}" "${MPI_C_LIBRARIES}") + libsummary("MPICXX" "${MPI_CXX_INCLUDE_DIRS}" "${MPI_CXX_LIBRARIES}") endif() endif() libsummary("BLAS" "" "${BLAS_LIBRARIES}") libsummary("LAPACK" "" "${LAPACK_LIBRARIES}") if (ICBEXMM) - libsummary("EIGEN3" "${EIGEN3_INCLUDE_DIRS}" "") + libsummary("EIGEN3" "${EIGEN3_INCLUDE_DIR}" "") +endif() +if (PYTHON3) + libsummary("PYTHON" "${PYTHON_INCLUDE_DIRS}" "${PYTHON_LIBRARIES}") + message(" -- exe: ${PYTHON_EXECUTABLE}") + libsummary("BOOST" "${Boost_INCLUDE_DIRS}" "${Boost_LIBRARIES}") endif() diff -Nru arpack-3.7.0/configure.ac arpack-3.8.0/configure.ac --- arpack-3.7.0/configure.ac 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/configure.ac 2020-12-07 10:40:45.000000000 +0000 @@ -1,5 +1,5 @@ AC_PREREQ(2.67) -AC_INIT([ARPACK-NG],[3.7.0],[https://github.com/opencollab/arpack-ng/issues/],[arpack-ng],[https://github.com/opencollab/arpack-ng/]) +AC_INIT([ARPACK-NG],[3.8.0],[https://github.com/opencollab/arpack-ng/issues/],[arpack-ng],[https://github.com/opencollab/arpack-ng/]) AC_CONFIG_SRCDIR([SRC/version.h]) AC_CONFIG_AUX_DIR([build-aux]) AC_CONFIG_MACRO_DIR([m4]) @@ -45,7 +45,7 @@ m4exit([1])]) LT_PREREQ([2.4.2]) -LT_INIT([win32-dll]) +LT_INIT([win32-dll disable-static]) dnl See if compiling parpack AC_ARG_ENABLE([mpi], @@ -55,11 +55,19 @@ [], [AS_VAR_SET([enable_mpi], [no])]) AS_IF([test x"$enable_mpi" != x"no"], [ + FCFLAGS_SAVE=$FCFLAGS + FCFLAGS="" + FFLAGS_SAVE=$FFLAGS + FFLAGS="" + AC_LANG_PUSH([Fortran 77]) AX_MPI([], AC_MSG_ERROR([could not compile a Fortran MPI test program])) AC_SUBST([MPI_Fortran_LIBS], [$MPILIBS]) F77=$MPIF77 AC_LANG_POP([Fortran 77]) + + FCFLAGS=$FCFLAGS_SAVE + FFLAGS=$FFLAGS_SAVE ]) dnl See if compiling with ISO_C_BINDING support @@ -77,7 +85,7 @@ [AS_VAR_SET([enable_icb_exmm], [no])]) if test x"$enable_icb_exmm" != x"no"; then - PKG_CHECK_MODULES([EIGEN3], [eigen3 >= 3.2]) + PKG_CHECK_MODULES([EIGEN3], [eigen3 >= 3.3]) AC_LANG_PUSH([C++]) CPPFLAGS_SAVE=$CPPFLAGS CPPFLAGS=$EIGEN3_CFLAGS @@ -93,6 +101,21 @@ AC_CHECK_HEADER([Eigen/SparseQR], [], [AC_MSG_ERROR([Eigen/SparseQR not found])]) + AC_CHECK_HEADER([Eigen/SparseCholesky], + [], + [AC_MSG_ERROR([Eigen/SparseCholesky not found])]) + AC_CHECK_HEADER([Eigen/Dense], + [], + [AC_MSG_ERROR([Eigen/Dense not found])]) + AC_CHECK_HEADER([Eigen/LU], + [], + [AC_MSG_ERROR([Eigen/LU not found])]) + AC_CHECK_HEADER([Eigen/QR], + [], + [AC_MSG_ERROR([Eigen/QR not found])]) + AC_CHECK_HEADER([Eigen/Cholesky], + [], + [AC_MSG_ERROR([Eigen/Cholesky not found])]) CPPFLAGS=$CPPFLAGS_SAVE AC_LANG_POP([C++]) fi @@ -121,10 +144,16 @@ AC_LANG_POP([Fortran]) if test x"$enable_mpi" != x"no"; then + FCFLAGS_SAVE=$FCFLAGS + FCFLAGS="" + FFLAGS_SAVE=$FFLAGS + FFLAGS="" + AC_LANG_PUSH([Fortran]) AX_MPI([], AC_MSG_ERROR([could not compile a Fortran MPI test program])) FC=$MPIFC - AC_FC_WRAPPERS dnl set FCLIBS + AC_FC_LIBRARY_LDFLAGS dnl set FCLIBS + AC_SUBST([MPI_Fortran_LIBS], ["$MPILIBS $FCLIBS"]) AC_LANG_POP([Fortran]) AC_LANG_PUSH([C]) @@ -155,6 +184,9 @@ ] ) AC_LANG_POP([C]) + + FCFLAGS=$FCFLAGS_SAVE + FFLAGS=$FFLAGS_SAVE fi AX_CXX_COMPILE_STDCXX(11) else @@ -222,9 +254,19 @@ AM_CONDITIONAL([ICBEXMM], [test x"$enable_icb_exmm" != x"no"]) m4_ifdef([PKG_INSTALLDIR], [PKG_INSTALLDIR], [AC_SUBST([pkgconfigdir], [${libdir}/pkgconfig])]) -AC_CONFIG_FILES([arpack$LIBSUFFIX.pc:arpack.pc.in], [], [LIBSUFFIX="$LIBSUFFIX"]) +AC_SUBST([ARPACK_PC_LIBS_PRIVATE], ["$LAPACK_LIBS $BLAS_LIBS"]) +AC_SUBST([PARPACK_PC_LIBS_PRIVATE], ["$LAPACK_LIBS $BLAS_LIBS $MPI_Fortran_LIBS"]) +AC_CONFIG_FILES([ + SRC/arpack$LIBSUFFIX.pc:SRC/arpack.pc.in + PARPACK/SRC/MPI/parpack$LIBSUFFIX.pc:PARPACK/SRC/MPI/parpack.pc.in +], [], [LIBSUFFIX="$LIBSUFFIX"]) + AC_CONFIG_FILES([ + EXAMPLES/MATRIX_MARKET/arpackSolver.pc arpackdef.h + arpackicb.h + arpack-ng-config-version.cmake + arpack-ng-config.cmake Makefile ICB/Makefile UTIL/Makefile @@ -274,6 +316,9 @@ CXX : $CXX CXXFLAGS : $CXXFLAGS CPPFLAGS : $CPPFLAGS +MPI_Fortran_LIBS : $MPI_Fortran_LIBS +MPI_C_LIBS : $MPI_C_LIBS +MPI_CXX_LIBS : $MPI_CXX_LIBS BLAS : $BLAS_LIBS LAPACK : $LAPACK_LIBS EIGEN : $EIGEN3_CFLAGS diff -Nru arpack-3.7.0/debian/changelog arpack-3.8.0/debian/changelog --- arpack-3.7.0/debian/changelog 2019-10-31 16:29:41.000000000 +0000 +++ arpack-3.8.0/debian/changelog 2022-09-21 19:08:43.000000000 +0000 @@ -1,3 +1,22 @@ +arpack (3.8.0-1~20.04.sav0) focal; urgency=medium + + * Backport to Focal + + -- Rob Savoury Wed, 21 Sep 2022 12:08:43 -0700 + +arpack (3.8.0-1) unstable; urgency=medium + + * New upstream release + Fix the gcc 10 issue (Closes: #957007) + * Bump debhelper from old 10 to 12. + * Set debhelper-compat version in Build-Depends. + * Set upstream metadata fields: Bug-Database, Bug-Submit, Repository, + Repository-Browse. + * Use canonical URL in Vcs-Browser. + * Standards-Version updated to 4.5.1 + + -- Sylvestre Ledru Mon, 07 Dec 2020 11:43:17 +0100 + arpack (3.7.0-3) unstable; urgency=medium * Enable C/C++ bindings @@ -344,11 +363,11 @@ * debian/source.lintian-overrides: Added to hide a lintian limitation. * debian/README.source: Added. - [ Adam C. Powell, IV ] + [ Adam C. Powell ] * Changed source format to 3.0 (quilt). * Fix octave segfault using patch from Thomas Weber (closes: #572935). - -- Adam C. Powell, IV Tue, 04 May 2010 16:05:05 -0400 + -- Adam C. Powell Tue, 04 May 2010 16:05:05 -0400 arpack (2.1+parpack96.dfsg-2) unstable; urgency=low @@ -391,14 +410,14 @@ * Modified copyright to indicate downloader and date for current copyright/license. - -- Adam C. Powell, IV Sun, 30 Nov 2008 11:09:12 -0500 + -- Adam C. Powell Sun, 30 Nov 2008 11:09:12 -0500 arpack (2.1+parpack96-9) unstable; urgency=low * Moved back to main because of change to 3-clause BSD license (closes: #491794). - -- Adam C. Powell, IV Mon, 24 Nov 2008 18:03:41 -0500 + -- Adam C. Powell Mon, 24 Nov 2008 18:03:41 -0500 arpack (2.1+parpack96-8) unstable; urgency=low @@ -406,7 +425,7 @@ * Added Adam Powell to the list of uploaders. * Added PARPACKLIB parameter to ARmake.inc. - -- Adam C. Powell, IV Mon, 10 Nov 2008 10:58:23 -0500 + -- Adam C. Powell Mon, 10 Nov 2008 10:58:23 -0500 arpack (2.1+parpack96-7) unstable; urgency=low diff -Nru arpack-3.7.0/debian/compat arpack-3.8.0/debian/compat --- arpack-3.7.0/debian/compat 2018-06-23 08:01:52.000000000 +0000 +++ arpack-3.8.0/debian/compat 1970-01-01 00:00:00.000000000 +0000 @@ -1,2 +0,0 @@ -10 - diff -Nru arpack-3.7.0/debian/control arpack-3.8.0/debian/control --- arpack-3.7.0/debian/control 2019-10-31 16:22:24.000000000 +0000 +++ arpack-3.8.0/debian/control 2020-12-07 10:43:17.000000000 +0000 @@ -3,14 +3,14 @@ Uploaders: Sylvestre Ledru Section: math Priority: optional -Build-Depends: debhelper (>= 10), +Build-Depends: debhelper-compat (= 12), gfortran, libblas-dev, liblapack-dev, mpi-default-dev, libeigen3-dev -Standards-Version: 4.2.1 -Vcs-Browser: https://salsa.debian.org/science-team/arpack.git +Standards-Version: 4.5.1 +Vcs-Browser: https://salsa.debian.org/science-team/arpack Vcs-Git: https://salsa.debian.org/science-team/arpack.git Homepage: https://github.com/opencollab/arpack-ng diff -Nru arpack-3.7.0/debian/rules arpack-3.8.0/debian/rules --- arpack-3.7.0/debian/rules 2019-10-31 16:29:41.000000000 +0000 +++ arpack-3.8.0/debian/rules 2020-12-07 10:43:17.000000000 +0000 @@ -8,7 +8,7 @@ override_dh_auto_configure: # Enforce generic BLAS (to avoid tying to ATLAS or OpenBLAS) - dh_auto_configure -- --enable-mpi --with-blas=blas --enable-icb + dh_auto_configure -- --enable-mpi --with-blas=blas --enable-icb --enable-static override_dh_auto_test: # Disable fakeroot because of https://bugs.debian.org/cgi-bin/bugreport.cgi?bug=839387 diff -Nru arpack-3.7.0/debian/upstream/metadata arpack-3.8.0/debian/upstream/metadata --- arpack-3.7.0/debian/upstream/metadata 1970-01-01 00:00:00.000000000 +0000 +++ arpack-3.8.0/debian/upstream/metadata 2020-12-07 10:43:17.000000000 +0000 @@ -0,0 +1,5 @@ +--- +Bug-Database: https://github.com/opencollab/arpack-ng/issues +Bug-Submit: https://github.com/opencollab/arpack-ng/issues/new +Repository: https://github.com/opencollab/arpack-ng.git +Repository-Browse: https://github.com/opencollab/arpack-ng diff -Nru arpack-3.7.0/EXAMPLES/MATRIX_MARKET/arpackmm.cpp arpack-3.8.0/EXAMPLES/MATRIX_MARKET/arpackmm.cpp --- arpack-3.7.0/EXAMPLES/MATRIX_MARKET/arpackmm.cpp 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/EXAMPLES/MATRIX_MARKET/arpackmm.cpp 2020-12-07 10:40:45.000000000 +0000 @@ -1,956 +1,969 @@ -// This code sample is meant for convenience (not performance): -// - test/run arpack (eigen values / vectors, timing). -// - play with modes: shift, invert, shift + invert. -// - use with user matrices (matrix market format). - -#include -#include -#include // stringstream. -#include // [io]fstream. -#include -#include -#include // max_element. #include -#include // epsilon. -#include // fabs. -#include // setw. -#include // assert. -#include // unique_ptr. -#include "arpack.h" -#include "debug_c.hpp" -#include -#include -#include -#include +#include "arpackSolver.hpp" +#include "debug_c.hpp" +#include "stat_c.hpp" using namespace std; -typedef Eigen::SparseMatrix< double> EigMatR; // Real. -typedef Eigen::Triplet < double> EigCooR; // Real. -typedef Eigen::SparseMatrix> EigMatC; // Complex. -typedef Eigen::Triplet > EigCooC; // Complex. -typedef Eigen::Matrix < double, Eigen::Dynamic, 1> EigVecR; // Real. -typedef Eigen::Map EigMpVR; // Real. -typedef Eigen::Matrix , Eigen::Dynamic, 1> EigVecC; // Complex. -typedef Eigen::Map EigMpVC; // Complex. -typedef Eigen::BiCGSTAB EigBiCGR; // Real. -typedef Eigen::ConjugateGradient EigCGR; // Real. -typedef Eigen::SparseLU> EigSLUR; // Real. -typedef Eigen::SparseQR> EigSQRR; // Real. -typedef Eigen::BiCGSTAB EigBiCGC; // Complex. -typedef Eigen::ConjugateGradient EigCGC; // Complex. -typedef Eigen::SparseLU> EigSLUC; // Complex. -typedef Eigen::SparseQR> EigSQRC; // Complex. - class options { - public: - options() { - fileA = "A.mtx"; - fileB = "N.A."; // Not available. - nbEV = 1; - nbCV = 2*nbEV + 1; - stdPb = true; // Standard or generalized (= not standard). - symPb = true; - cpxPb = false; - mag = string("LM"); // Large magnitude. - shiftReal = false; shiftImag = false; - sigmaReal = 0.; sigmaImag = 0.; // Eigen value translation: look for lambda+sigma instead of lambda. - invert = false; // Eigen value invertion: look for 1./lambda instead of lambda. - tol = 1.e-06; - maxIt = 100; - schur = false; // Compute Ritz vectors. - slv = "BiCG"; - slvItrTol = nullptr; - slvItrMaxIt = nullptr; - slvDrtPvtThd = nullptr; - check = true; - verbose = 0; - debug = 0; - restart = false; - }; - - int readCmdLine(int argc, char ** argv) { - // Check for command line independent parameters. - - for (int a = 1; argv && a < argc; a++) { - string clo = argv[a]; // Command line option. - if (clo == "--help") return usage(0); - if (clo == "--A") { - a++; if (a >= argc) {cerr << "Error: bad " << clo << " - need argument" << endl; return usage();} - fileA = argv[a]; - } - if (clo == "--nbEV") { - a++; if (a >= argc) {cerr << "Error: bad " << clo << " - need argument" << endl; return usage();} - stringstream nEV(argv[a]); - nEV >> nbEV; if (!nEV) {cerr << "Error: bad " << clo << " - bad argument" << endl; return usage();} - nbCV = 2*nbEV + 1; - } - if (clo == "--genPb") { - stdPb = false; - fileB = "B.mtx"; - } - if (clo == "--nonSymPb") symPb = false; - if (clo == "--cpxPb") { - symPb = false; - cpxPb = true; - } - if (clo == "--mag") { - a++; if (a >= argc) {cerr << "Error: bad " << clo << " - need argument" << endl; return usage();} - mag = argv[a]; // small mag (likely poor perf) <=> large mag + invert (likely good perf). - bool ok = (mag == "LM" || mag == "SM" || mag == "LR" || mag == "SR" || mag == "LI" || mag == "SI") ? true : false; - if (!ok) {cerr << "Error: bad " << clo << " - bad argument" << endl; return usage();} - } - if (clo == "--shiftReal") { - shiftReal = true; - a++; if (a >= argc) {cerr << "Error: bad " << clo << " - need argument" << endl; return usage();} - stringstream s(argv[a]); - s >> sigmaReal; if (!s) {cerr << "Error: bad " << clo << " - bad argument" << endl; return usage();} - } - if (clo == "--shiftImag") { - shiftImag = true; - a++; if (a >= argc) {cerr << "Error: bad " << clo << " - need argument" << endl; return usage();} - stringstream s(argv[a]); - s >> sigmaImag; if (!s) {cerr << "Error: bad " << clo << " - bad argument" << endl; return usage();} - } - if (clo == "--invert") invert = true; - if (clo == "--tol") { - a++; if (a >= argc) {cerr << "Error: bad " << clo << " - need argument" << endl; return usage();} - stringstream t(argv[a]); - t >> tol; if (!t) {cerr << "Error: bad " << clo << " - bad argument" << endl; return usage();} - } - if (clo == "--maxIt") { - a++; if (a >= argc) {cerr << "Error: bad " << clo << " - need argument" << endl; return usage();} - stringstream mi(argv[a]); - mi >> maxIt; if (!mi) {cerr << "Error: bad " << clo << " - bad argument" << endl; return usage();} - } - if (clo == "--slv") { - a++; if (a >= argc) {cerr << "Error: bad " << clo << " - need argument" << endl; return usage();} - slv = argv[a]; - } - if (clo == "--slvItrTol") { - a++; if (a >= argc) {cerr << "Error: bad " << clo << " - need argument" << endl; return usage();} - stringstream t(argv[a]); - double tol = 0.; - t >> tol; if (!t) {cerr << "Error: bad " << clo << " - bad argument" << endl; return usage();} - slvItrTol = unique_ptr(new double); - if (slvItrTol) *slvItrTol = tol; - } - if (clo == "--slvItrMaxIt") { - a++; if (a >= argc) {cerr << "Error: bad " << clo << " - need argument" << endl; return usage();} - stringstream mi(argv[a]); - int maxIt = 0; - mi >> maxIt; if (!mi) {cerr << "Error: bad " << clo << " - bad argument" << endl; return usage();} - slvItrMaxIt = unique_ptr(new int); - if (slvItrMaxIt) *slvItrMaxIt = maxIt; - } - if (clo == "--slvDrtPvtThd") { - a++; if (a >= argc) {cerr << "Error: bad " << clo << " - need argument" << endl; return usage();} - stringstream t(argv[a]); - double thd = 0.; - t >> thd; if (!t) {cerr << "Error: bad " << clo << " - bad argument" << endl; return usage();} - slvDrtPvtThd = unique_ptr(new double); - if (slvDrtPvtThd) *slvDrtPvtThd = thd; - } - if (clo == "--noCheck") check = false; - if (clo == "--verbose") { - a++; if (a >= argc) {cerr << "Error: bad " << clo << " - need argument" << endl; return usage();} - stringstream vb(argv[a]); - vb >> verbose; if (!vb) {cerr << "Error: bad " << clo << " - bad argument" << endl; return usage();} - } - if (clo == "--debug") { - a++; if (a >= argc) {cerr << "Error: bad " << clo << " - need argument" << endl; return usage();} - stringstream dbg(argv[a]); - dbg >> debug; if (!dbg) {cerr << "Error: bad " << clo << " - bad argument" << endl; return usage();} - if (debug > 3) debug = 3; - debug_c(6, -6, debug, debug, debug, debug, debug, debug, debug, debug, debug, debug, debug, - debug, debug, debug, debug, debug, debug, debug, debug, debug, debug, debug); - } - if (clo == "--restart") restart = true; - } - - // Check for command line dependent parameters. - - for (int a = 1; argv && a < argc; a++) { - string clo = argv[a]; // Command line option. - if (clo == "--nbCV") { - a++; if (a >= argc) {cerr << "Error: bad " << clo << " - need argument" << endl; return usage();} - stringstream nCV(argv[a]); - nCV >> nbCV; if (!nCV) {cerr << "Error: bad " << clo << " - bad argument" << endl; return usage();} - } - if (clo == "--B") { - a++; if (a >= argc) {cerr << "Error: bad " << clo << " - need argument" << endl; return usage();} - fileB = argv[a]; - } - } - - return 0; - }; - - int usage(int rc = 1) { - cout << "Usage: running arpack to check for eigen values/vectors." << endl; - cout << endl; - cout << " --A F: file name of matrix A such that A X = lambda X. (standard)" << endl; - cout << " default: A.mtx" << endl; - cout << " --B F: file name of matrix B such that A X = lambda B X. (generalized)" << endl; - cout << " default: N.A. for standard problem, or, B.mtx for generalized problem" << endl; - cout << " --nbEV: number of eigen values/vectors to compute." << endl; - cout << " default: 1" << endl; - cout << " --nbCV: number of columns of the matrix V." << endl; - cout << " default: 2*nbEV+1" << endl; - cout << " --genPb: generalized problem." << endl; - cout << " default: standard problem" << endl; - cout << " --nonSymPb: non symmetric problem (<=> use dn[ae]upd)." << endl; - cout << " default: symmetric problem (<=> use ds[ae]upd)" << endl; - cout << " --cpxPb: complex (non symmetric) problem (<=> use zn[ae]upd)." << endl; - cout << " default: false (<=> use d*[ae]upd)" << endl; - cout << " --mag M: set magnitude of eigen values to look for (LM, SM, LR, SR, LI, SI)." << endl; - cout << " default: large magnitude (LM)" << endl; - cout << " --shiftReal S: real shift where sigma = S (look for lambda+S instead of lambda)." << endl; - cout << " default: no shift, S = 0." << endl; - cout << " --shiftImag S: imaginary shift where sigma = S (look for lambda+S instead of lambda)." << endl; - cout << " default: no shift, S = 0." << endl; - cout << " --invert: invert mode (look for 1./lambda instead of lambda)." << endl; - cout << " default: no invert" << endl; - cout << " --tol T: tolerance T." << endl; - cout << " default: 1.e-06" << endl; - cout << " --maxIt M: maximum iterations M." << endl; - cout << " default: 100" << endl; - cout << " --schur: compute Schur vectors." << endl; - cout << " the Schur decomposition is such that A = Q^H x T x Q where:" << endl; - cout << " - the H superscript refers to the Hermitian transpose: Q^H = (Q^t)^*." << endl; - cout << " - Q is unitary: Q is such that Q^H x Q = I." << endl; - cout << " - T is an upper-triangular matrix whose diagonal elements are the eigenvalues of A." << endl; - cout << " every square matrix has a Schur decomposition: columns of Q are the Schur vectors." << endl; - cout << " for a general matrix A, there is no relation between Schur vectors of A and eigenvectors of A." << endl; - cout << " if q_j is the i-th Schur vector, then A x q_j is a linear combination of q_1, ..., q_j." << endl; - cout << " Schur vectors q_1, q_2, ..., q_j span an invariant subspace of A." << endl; - cout << " the Schur vectors and eigenvectors of A are the same if A is a normal matrix." << endl; - cout << " default: compute Ritz vectors (approximations of eigen vectors)" << endl; - cout << " --slv S: solver (BiCG, CG, LU)" << endl; - cout << " BiCG: iterative method, any matrices" << endl; - cout << " CG: iterative method, sym matrices only" << endl; - cout << " LU: direct method, any matrices" << endl; - cout << " QR: direct method, any matrices" << endl; - cout << " default: BiCG" << endl; - cout << " --slvItrTol T: solver tolerance T (for iterative solvers)." << endl; - cout << " default: eigen default value" << endl; - cout << " --slvItrMaxIt M: solver maximum iterations M (for iterative solvers)." << endl; - cout << " default: eigen default value" << endl; - cout << " --slvDrtPvtThd T: solver pivot threshold T (for direct solvers)." << endl; - cout << " default: eigen default value" << endl; - cout << " --noCheck: check arpack eigen values/vectors." << endl; - cout << " check will fail if Schur vectors are computed and A is NOT a normal matrix." << endl; - cout << " default: check" << endl; - cout << " --verbose V: verbosity level (up to 3)." << endl; - cout << " default: 0" << endl; - cout << " --debug D: debug level (up to 3)." << endl; - cout << " default: 0" << endl; - cout << " --restart: restart from previous run (which had produced resid.out and v.out)." << endl; - cout << " default: false" << endl; - if (rc == 0) exit(0); - return rc; - }; - - friend ostream & operator<< (ostream & ostr, options const & opt); - - string fileA; - string fileB; - a_int nbEV; - a_int nbCV; - bool stdPb; // Standard or generalized (= not standard). - bool symPb; - bool cpxPb; - string mag; // Magnitude <=> "which" arpack parameter. - bool shiftReal, shiftImag; - double sigmaReal, sigmaImag; // Eigen value translation: look for lambda+sigma instead of lambda. - bool invert; // Eigen value invertion: look for 1./lambda instead of lambda. - double tol; - int maxIt; - bool schur; - string slv; - unique_ptr slvItrTol; - unique_ptr slvItrMaxIt; - unique_ptr slvDrtPvtThd; - bool check; - int verbose; - int debug; - bool restart; + public: + options() { + fileA = "A.mtx"; + fileB = "N.A."; // Not available. + dense = false; + denseRR = true; + nbEV = 1; + nbCV = 2 * nbEV + 1; + stdPb = true; // Standard or generalized (= not standard). + symPb = true; + cpxPb = false; + simplePrec = false; // Double precision. + mag = string("LM"); // Large magnitude. + shiftReal = false; + shiftImag = false; + sigmaReal = 0.; + sigmaImag = 0.; // Eigen value translation: look for lambda+sigma instead + // of lambda. + invert = + false; // Eigen value invertion: look for 1./lambda instead of lambda. + tol = 1.e-06; + maxIt = 100; + schur = false; // Compute Ritz vectors. + slv = "BiCG"; + slvItrTol = 1.e-6; + slvItrMaxIt = 100; + slvItrPC = "Diag"; + slvDrtPivot = 1.e-6; + slvDrtOffset = 0.; + slvDrtScale = 1.; + check = true; + verbose = 0; + debug = 0; + restart = false; + }; + + int readCmdLine(int argc, char** argv) { + // Check for command line independent parameters. + + for (int a = 1; argv && a < argc; a++) { + string clo = argv[a]; // Command line option. + if (clo == "--help") return usage(0); + if (clo == "--A") { + a++; + if (a >= argc) { + cerr << "Error: bad " << clo << " - need argument" << endl; + return usage(); + } + fileA = argv[a]; + } + if (clo == "--dense") { + dense = true; + a++; + if (a >= argc) { + cerr << "Error: bad " << clo << " - need argument" << endl; + return usage(); + } + string rr(argv[a]); + if (rr != "true" && rr != "false") { + cerr << "Error: bad " << clo << " - bad argument" << endl; + return usage(); + } + denseRR = (rr == "true") ? true : false; + } + if (clo == "--nbEV") { + a++; + if (a >= argc) { + cerr << "Error: bad " << clo << " - need argument" << endl; + return usage(); + } + stringstream nEV(argv[a]); + nEV >> nbEV; + if (!nEV) { + cerr << "Error: bad " << clo << " - bad argument" << endl; + return usage(); + } + nbCV = 2 * nbEV + 1; + } + if (clo == "--genPb") { + stdPb = false; + fileB = "B.mtx"; + } + if (clo == "--nonSymPb") symPb = false; + if (clo == "--cpxPb") { + symPb = false; + cpxPb = true; + } + if (clo == "--simplePrec") simplePrec = true; + if (clo == "--mag") { + a++; + if (a >= argc) { + cerr << "Error: bad " << clo << " - need argument" << endl; + return usage(); + } + mag = argv[a]; // small mag (likely poor perf) <=> large mag + invert + // (likely good perf). + bool ok = (mag == "LM" || mag == "SM" || mag == "LR" || mag == "SR" || + mag == "LI" || mag == "SI") + ? true + : false; + if (!ok) { + cerr << "Error: bad " << clo << " - bad argument" << endl; + return usage(); + } + } + if (clo == "--shiftReal") { + shiftReal = true; + a++; + if (a >= argc) { + cerr << "Error: bad " << clo << " - need argument" << endl; + return usage(); + } + stringstream s(argv[a]); + s >> sigmaReal; + if (!s) { + cerr << "Error: bad " << clo << " - bad argument" << endl; + return usage(); + } + } + if (clo == "--shiftImag") { + shiftImag = true; + a++; + if (a >= argc) { + cerr << "Error: bad " << clo << " - need argument" << endl; + return usage(); + } + stringstream s(argv[a]); + s >> sigmaImag; + if (!s) { + cerr << "Error: bad " << clo << " - bad argument" << endl; + return usage(); + } + } + if (clo == "--invert") invert = true; + if (clo == "--tol") { + a++; + if (a >= argc) { + cerr << "Error: bad " << clo << " - need argument" << endl; + return usage(); + } + stringstream t(argv[a]); + t >> tol; + if (!t) { + cerr << "Error: bad " << clo << " - bad argument" << endl; + return usage(); + } + } + if (clo == "--maxIt") { + a++; + if (a >= argc) { + cerr << "Error: bad " << clo << " - need argument" << endl; + return usage(); + } + stringstream mi(argv[a]); + mi >> maxIt; + if (!mi) { + cerr << "Error: bad " << clo << " - bad argument" << endl; + return usage(); + } + } + if (clo == "--slv") { + a++; + if (a >= argc) { + cerr << "Error: bad " << clo << " - need argument" << endl; + return usage(); + } + slv = argv[a]; + } + if (clo == "--slvItrTol") { + a++; + if (a >= argc) { + cerr << "Error: bad " << clo << " - need argument" << endl; + return usage(); + } + stringstream t(argv[a]); + double tol = 0.; + t >> slvItrTol; + if (!t) { + cerr << "Error: bad " << clo << " - bad argument" << endl; + return usage(); + } + } + if (clo == "--slvItrMaxIt") { + a++; + if (a >= argc) { + cerr << "Error: bad " << clo << " - need argument" << endl; + return usage(); + } + stringstream mi(argv[a]); + int maxIt = 0; + mi >> slvItrMaxIt; + if (!mi) { + cerr << "Error: bad " << clo << " - bad argument" << endl; + return usage(); + } + } + if (clo == "--slvItrPC") { + a++; + if (a >= argc) { + cerr << "Error: bad " << clo << " - need argument" << endl; + return usage(); + } + stringstream pc(argv[a]); + pc >> slvItrPC; + if (!pc) { + cerr << "Error: bad " << clo << " - bad argument" << endl; + return usage(); + } + } + if (clo == "--slvDrtPivot") { + a++; + if (a >= argc) { + cerr << "Error: bad " << clo << " - need argument" << endl; + return usage(); + } + stringstream pv(argv[a]); + pv >> slvDrtPivot; + if (!pv) { + cerr << "Error: bad " << clo << " - bad argument" << endl; + return usage(); + } + } + if (clo == "--slvDrtOffset") { + a++; + if (a >= argc) { + cerr << "Error: bad " << clo << " - need argument" << endl; + return usage(); + } + stringstream of(argv[a]); + of >> slvDrtOffset; + if (!of) { + cerr << "Error: bad " << clo << " - bad argument" << endl; + return usage(); + } + } + if (clo == "--slvDrtScale") { + a++; + if (a >= argc) { + cerr << "Error: bad " << clo << " - need argument" << endl; + return usage(); + } + stringstream sc(argv[a]); + sc >> slvDrtScale; + if (!sc) { + cerr << "Error: bad " << clo << " - bad argument" << endl; + return usage(); + } + } + if (clo == "--noCheck") check = false; + if (clo == "--verbose") { + a++; + if (a >= argc) { + cerr << "Error: bad " << clo << " - need argument" << endl; + return usage(); + } + stringstream vb(argv[a]); + vb >> verbose; + if (!vb) { + cerr << "Error: bad " << clo << " - bad argument" << endl; + return usage(); + } + } + if (clo == "--debug") { + a++; + if (a >= argc) { + cerr << "Error: bad " << clo << " - need argument" << endl; + return usage(); + } + stringstream dbg(argv[a]); + dbg >> debug; + if (!dbg) { + cerr << "Error: bad " << clo << " - bad argument" << endl; + return usage(); + } + if (debug > 3) debug = 3; + debug_c(6, -6, debug, debug, debug, debug, debug, debug, debug, debug, + debug, debug, debug, debug, debug, debug, debug, debug, debug, + debug, debug, debug, debug, debug); + } + if (clo == "--restart") restart = true; + } + + // Check for command line dependent parameters. + + for (int a = 1; argv && a < argc; a++) { + string clo = argv[a]; // Command line option. + if (clo == "--nbCV") { + a++; + if (a >= argc) { + cerr << "Error: bad " << clo << " - need argument" << endl; + return usage(); + } + stringstream nCV(argv[a]); + nCV >> nbCV; + if (!nCV) { + cerr << "Error: bad " << clo << " - bad argument" << endl; + return usage(); + } + } + if (clo == "--B") { + a++; + if (a >= argc) { + cerr << "Error: bad " << clo << " - need argument" << endl; + return usage(); + } + fileB = argv[a]; + } + } + + return 0; + }; + + int usage(int rc = 1) { + cout << "Usage: running arpack with matrix market files to check for eigen " + "values/vectors." + << endl; + cout << endl; + cout << " --A F: file name of matrix A such that A X = lambda " + "X. (standard)" + << endl; + cout << " the file F must be compliant with the matrix " + "market format." + << endl; + cout << " default: A.mtx" << endl; + cout << " --B F: file name of matrix B such that A X = lambda " + "B X. (generalized)" + << endl; + cout << " the file F must be compliant with the matrix " + "market format." + << endl; + cout << " default: N.A. for standard problem, or, B.mtx " + "for generalized problem" + << endl; + cout << " --dense RR: consider A and B as dense matrices." << endl; + cout << " if RR = true, use more-stable-but-slow " + "versions of LU / QR (rank revealing)." + << endl; + cout << " if RR = false, use less-stable-but-fast " + "versions of LU / QR (depends on condition number)." + << endl; + cout << " Notes:" << endl; + cout << " - only direct solvers are available when " + "using dense matrices." + << endl; + cout + << " - RR does not impact the use of LLT and LDLT." + << endl; + cout << " - thresholds only make sense for " + "rank-revealing decompositions." + << endl; + cout << " default: consider A and B as sparse matrices" + << endl; + cout << " --nbEV: number of eigen values/vectors to compute." + << endl; + cout << " default: 1" << endl; + cout << " --nbCV: number of columns of the matrix V." << endl; + cout << " default: 2*nbEV+1" << endl; + cout << " --genPb: generalized problem." << endl; + cout << " default: standard problem" << endl; + cout << " --nonSymPb: non symmetric problem (<=> use dn[ae]upd)." + << endl; + cout << " default: symmetric problem (<=> use ds[ae]upd)" + << endl; + cout << " --cpxPb: complex (non symmetric) problem (<=> use " + "zn[ae]upd)." + << endl; + cout << " default: false (<=> use d*[ae]upd)" << endl; + cout << " --simplePrec: use simple precision (less accurate, but, " + "half memory footprint)." + << endl; + cout << " default: false (<=> use double precision: use " + "[dz]*upd)" + << endl; + cout << " --mag M: set magnitude of eigen values to look for " + "(LM, SM, LR, SR, LI, SI)." + << endl; + cout << " default: large magnitude (LM)" << endl; + cout << " --shiftReal S: real shift where sigma = S (look for lambda+S " + "instead of lambda)." + << endl; + cout << " default: no shift, S = 0." << endl; + cout << " --shiftImag S: imaginary shift where sigma = S (look for " + "lambda+S instead of lambda)." + << endl; + cout << " default: no shift, S = 0." << endl; + cout << " --invert: invert mode (look for 1./lambda instead of " + "lambda)." + << endl; + cout << " default: no invert" << endl; + cout << " --tol T: tolerance T." << endl; + cout << " default: 1.e-06" << endl; + cout << " --maxIt M: maximum iterations M." << endl; + cout << " default: 100" << endl; + cout << " --schur: compute Schur vectors." << endl; + cout << " the Schur decomposition is such that A = " + "Q^H x T x Q where:" + << endl; + cout << " - the H superscript refers to the " + "Hermitian transpose: Q^H = (Q^t)^*." + << endl; + cout + << " - Q is unitary: Q is such that Q^H x Q = I." + << endl; + cout << " - T is an upper-triangular matrix whose " + "diagonal elements are the eigenvalues of A." + << endl; + cout << " every square matrix has a Schur " + "decomposition: columns of Q are the Schur vectors." + << endl; + cout << " for a general matrix A, there is no " + "relation between Schur vectors of A and eigenvectors of A." + << endl; + cout << " if q_j is the j-th Schur vector, then A x " + "q_j is a linear combination of q_1, ..., q_j." + << endl; + cout << " Schur vectors q_1, q_2, ..., q_j span an " + "invariant subspace of A." + << endl; + cout << " the Schur vectors and eigenvectors of A are " + "the same if A is a normal matrix." + << endl; + cout << " default: compute Ritz vectors (approximations " + "of eigen vectors)" + << endl; + cout << " --slv S: solver (needed if arpack mode > 1)." << endl; + cout << " BiCG: iterative method, any matrices" + << endl; + cout << " CG: iterative method, sym matrices only" + << endl; + cout << " LU: direct method, any matrices (pivoting " + "needed)" + << endl; + cout << " QR: direct method, any matrices (pivoting " + "needed)" + << endl; + cout << " LLT: direct method, SPD matrices only " + "(pivoting not needed)" + << endl; + cout << " LDLT: direct method, symmetric positive " + "semi-definite matrices only (pivoting not needed)" + << endl; + cout << " default: BiCG" << endl; + cout << " --slvItrTol T: solver tolerance T (for iterative solvers)." + << endl; + cout << " default: 1.e-6" << endl; + cout << " --slvItrMaxIt M: solver maximum iterations M (for iterative " + "solvers)." + << endl; + cout << " default: 100" << endl; + cout << " --slvItrPC PC: solver preconditioner (for iterative solvers)." + << endl; + cout << " PC preconditioner:" << endl; + cout << " Diag: eigen diagonal preconditioner " + "(Jacobi)." + << endl; + cout << " ILU#D#F: eigen ILU preconditioner." + << endl; + cout << " D: drop tolerance." << endl; + cout << " F: fill factor." << endl; + cout << " default: diagonal preconditioner (Jacobi)" + << endl; + cout << " --slvDrtPivot: P solver pivot P (for direct solvers)." << endl; + cout << " default: 1.e-06" << endl; + cout << " --slvDrtOffset: O solver offset O (for direct solvers)." << endl; + cout << " default: 0." << endl; + cout << " --slvDrtScale: S solver scale S (for direct solvers)." << endl; + cout << " default: 1." << endl; + cout << " --noCheck: check arpack eigen values/vectors." << endl; + cout << " check will fail if Schur vectors are computed " + "and A is NOT a normal matrix." + << endl; + cout << " default: check" << endl; + cout << " --verbose V: verbosity level (up to 3)." << endl; + cout << " default: 0" << endl; + cout << " --debug D: debug level (up to 3)." << endl; + cout << " default: 0" << endl; + cout << " --restart: restart from previous run (which had produced " + "arpackSolver.*.out)." + << endl; + cout << " restart from eigen basis approximation " + "computed during a previous run." + << endl; + cout << " default: false" << endl; + if (rc == 0) exit(0); + return rc; + }; + + friend ostream& operator<<(ostream& ostr, options const& opt); + + string fileA; + string fileB; + bool dense; + bool denseRR; + a_int nbEV; + a_int nbCV; + bool stdPb; // Standard or generalized (= not standard). + bool symPb; + bool cpxPb; + bool simplePrec; + string mag; // Magnitude <=> "which" arpack parameter. + bool shiftReal, shiftImag; + double sigmaReal, sigmaImag; // Eigen value translation: look for + // lambda+sigma instead of lambda. + bool invert; // Eigen value invertion: look for 1./lambda instead of lambda. + double tol; + int maxIt; + bool schur; + string slv; + double slvItrTol; + int slvItrMaxIt; + string slvItrPC; + double slvDrtPivot; + double slvDrtOffset; + double slvDrtScale; + bool check; + int verbose; + a_int debug; + bool restart; }; -ostream & operator<< (ostream & ostr, options const & opt) { +ostream& operator<<(ostream& ostr, options const& opt) { ostr << "OPT: A " << opt.fileA << ", B " << opt.fileB; - ostr << ", nbEV " << opt.nbEV << ", nbCV " << opt.nbCV << ", stdPb " << (opt.stdPb ? "yes" : "no"); - ostr << ", symPb " << (opt.symPb ? "yes" : "no") << ", mag " << opt.mag << endl; - ostr << "OPT: shiftReal " << (opt.shiftReal ? "yes" : "no") << ", sigmaReal " << opt.sigmaReal; - ostr << ", shiftImag " << (opt.shiftImag ? "yes" : "no") << ", sigmaImag " << opt.sigmaImag; - ostr << ", invert " << (opt.invert ? "yes" : "no") << ", tol " << opt.tol << ", maxIt " << opt.maxIt; + if (opt.dense && opt.denseRR) + ostr << ", dense yes (RR true)"; + else if (opt.dense && !opt.denseRR) + ostr << ", dense yes (RR false)"; + else + ostr << ", dense no"; + ostr << ", nbEV " << opt.nbEV << ", nbCV " << opt.nbCV << ", stdPb " + << (opt.stdPb ? "yes" : "no"); + ostr << ", symPb " << (opt.symPb ? "yes" : "no") << ", cpxPb " + << (opt.cpxPb ? "yes" : "no"); + ostr << ", simplePrec " << (opt.simplePrec ? "yes" : "no") << ", mag " + << opt.mag << endl; + ostr << "OPT: shiftReal " << (opt.shiftReal ? "yes" : "no") << ", sigmaReal " + << opt.sigmaReal; + ostr << ", shiftImag " << (opt.shiftImag ? "yes" : "no") << ", sigmaImag " + << opt.sigmaImag; + ostr << ", invert " << (opt.invert ? "yes" : "no") << ", tol " << opt.tol + << ", maxIt " << opt.maxIt; ostr << ", " << (opt.schur ? "Schur" : "Ritz") << " vectors" << endl; - ostr << "OPT: slv " << opt.slv; - if (opt.slvItrTol) ostr << ", slvItrTol " << *opt.slvItrTol; - if (opt.slvItrMaxIt) ostr << ", slvItrMaxIt " << *opt.slvItrMaxIt; - if (opt.slvDrtPvtThd) ostr << ", slvDrtPvtThd " << *opt.slvDrtPvtThd; - ostr << ", check " << (opt.check ? "yes" : "no") << ", verbose " << opt.verbose << ", debug " << opt.debug; + ostr << "OPT: slv " << opt.slv << ", slvItrPC " << opt.slvItrPC + << ", slvItrTol " << opt.slvItrTol; + ostr << ", slvItrMaxIt " << opt.slvItrMaxIt << ", slvDrtPivot " + << opt.slvDrtPivot; + ostr << ", slvDrtOffset " << opt.slvDrtOffset << ", slvDrtScale " + << opt.slvDrtScale << endl; + ostr << "OPT: check " << (opt.check ? "yes" : "no") << ", verbose " + << opt.verbose << ", debug " << opt.debug; ostr << ", restart " << (opt.restart ? "yes" : "no") << endl; return ostr; } -void makeZero( double & zero) {zero = 0.;} +class output { + public: + output() { + nbVal = 0; + mode = 0; + nbIt = 0; + imsTime = 0.; + rciTime = 0.; + }; + + int nbVal; // Eigen values. + int mode; // Arpack mode. + int nbIt; // Arpack number of iterations. + double imsTime; // Init mode solver time. + double rciTime; // Reverse communication interface time. +}; -void makeZero(complex & zero) {zero = complex(0., 0.);} +template +int itrSolve(options& opt, output& out, double const& slvItrILUDropTol, + double const& slvItrILUFillFactor) { + // Init solver. + + arpackItrSolver as; + as.symPb = opt.symPb; + as.nbEV = opt.nbEV; + as.nbCV = opt.nbCV; + as.tol = opt.tol; + as.sigmaReal = opt.sigmaReal; + as.sigmaImag = opt.sigmaImag; + as.dumpToFile = true; + as.restartFromFile = opt.restart; + as.mag = opt.mag; + as.maxIt = opt.maxIt; + as.schur = opt.schur; + as.verbose = opt.verbose; + as.slvTol = opt.slvItrTol; + as.slvMaxIt = opt.slvItrMaxIt; + as.slvILUDropTol = slvItrILUDropTol; + as.slvILUFillFactor = slvItrILUFillFactor; -template -int readMatrixMarket(string const & fileName, EM & M, int const & verbose, string const & msg) { - ifstream inp(fileName); - if (!inp) {cerr << "Error: can not open " << fileName << endl; return 1;} + // Read A and B matrices. - a_uint l = 0, n = 0, m = 0, nnz = 0; - vector i, j; - vector Mij; - do { - // Skip comments. + EM A; + auto start = chrono::high_resolution_clock::now(); + int rc = as.createMatrix(opt.fileA, A); + if (rc != 0) { + cerr << "Error: read A KO" << endl; + return rc; + } + auto stop = chrono::high_resolution_clock::now(); + double readATime = + chrono::duration_cast(stop - start).count() / 1000.; + cout << endl; + cout << "INP: create A " << readATime << " s" << endl; - string inpLine; getline(inp, inpLine); l++; - while (isspace(*inpLine.begin())) inpLine.erase(inpLine.begin()); // Suppress leading white spaces. - if (inpLine.length() == 0) continue; // Empty line. - if (inpLine[0] == '%') continue; // Comments skipped, begin reading. + if (opt.nbCV > A.cols()) opt.nbCV = A.cols(); /* Cut-off */ - // Read matrix market file. + EM B; + if (!opt.stdPb) { + start = chrono::high_resolution_clock::now(); + rc = as.createMatrix(opt.fileB, B); + if (rc != 0) { + cerr << "Error: read B KO" << endl; + return rc; + } + stop = chrono::high_resolution_clock::now(); + double readBTime = + chrono::duration_cast(stop - start).count() / + 1000.; + cout << endl; + cout << "INP: create B " << readBTime << " s" << endl; - stringstream inpSS(inpLine); - if (n == 0 && m == 0) { // Header. - inpSS >> n >> m; - if (!inpSS) {cerr << "Error: bad header (n, m)" << endl; return 1;} - if (nnz == 0) { - inpSS >> nnz; - if (inpSS) { // OK, (optional) nnz has been provided. - i.reserve(nnz); - j.reserve(nnz); - Mij.reserve(nnz); - } - } + if (A.rows() != B.rows()) { + cerr << "Error: A.rows() != B.rows()" << endl; + return rc; } - else { // Body. - a_uint k = 0, l = 0; - RC zero; makeZero(zero); - RC Mkl = zero; - inpSS >> k >> l >> Mkl; - if (!inpSS) {cerr << "Error: bad line (" << fileName << ", line " << l << ")" << endl; return 1;} - i.push_back(k); - j.push_back(l); - Mij.push_back(Mkl); + if (A.cols() != B.cols()) { + cerr << "Error: A.cols() != B.cols()" << endl; + return rc; } } - while (inp); - // Handle 1-based -> 0-based. + // Solve. - nnz = i.size(); // In case nnz was not provided. - if (*max_element(begin(i), end(i)) == n || *max_element(begin(j), end(j)) == m) { - for (size_t k = 0; k < nnz; k++) i[k] -= 1; - for (size_t k = 0; k < nnz; k++) j[k] -= 1; + rc = as.solve(A, opt.stdPb ? nullptr : &B); + if (rc != 0) { + cerr << "Error: solve KO" << endl; + return rc; + } + if (opt.check) { + rc = as.checkEigVec(A, opt.stdPb ? nullptr : &B); + if (rc != 0) { + cerr << "Error: check KO" << endl; + return rc; + } } - // Create matrix from file. - - M = EM(n, m); // Set matrice dimensions. - vector triplets; - triplets.reserve(nnz); - for (size_t k = 0; k < nnz; k++) triplets.emplace_back(i[k], j[k], Mij[k]); - M.setFromTriplets(triplets.begin(), triplets.end()); // Set all (i, j, Mij). + // Retrieve outputs. - if (verbose == 3) { - cout << endl << msg << endl; - cout << endl << M << endl; - } + out.nbVal = as.val.size(); + out.mode = as.mode; + out.nbIt = as.nbIt; + out.imsTime = as.imsTime; + out.rciTime = as.rciTime; return 0; } -class arpackEV { // Arpack eigen values / vectors. - public: - vector> val; // Eigen values. - vector vec; // Eigen vectors. - int nbIt; - double rciTime; -}; +template +int drtSolve(options& opt, output& out) { + // Init solver. + + arpackDrtSolver as; + as.symPb = opt.symPb; + as.nbEV = opt.nbEV; + as.nbCV = opt.nbCV; + as.tol = opt.tol; + as.sigmaReal = opt.sigmaReal; + as.sigmaImag = opt.sigmaImag; + as.dumpToFile = true; + as.restartFromFile = opt.restart; + as.mag = opt.mag; + as.maxIt = opt.maxIt; + as.schur = opt.schur; + as.verbose = opt.verbose; + as.slvPvtThd = opt.slvDrtPivot; + as.slvOffset = opt.slvDrtOffset; + as.slvScale = opt.slvDrtScale; -void arpackAUPD(options const & opt, - a_int * ido, char const * bMat, a_int nbDim, char const * which, double * resid, double * v, - a_int ldv, a_int * iparam, a_int * ipntr, double * workd, double * workl, a_int lworkl, double * & rwork, - a_int * info) { - assert(rwork == NULL); - if (opt.symPb) { - dsaupd_c(ido, bMat, nbDim, which, opt.nbEV, opt.tol, resid, opt.nbCV, v, ldv, iparam, ipntr, workd, workl, lworkl, info); - } - else { - dnaupd_c(ido, bMat, nbDim, which, opt.nbEV, opt.tol, resid, opt.nbCV, v, ldv, iparam, ipntr, workd, workl, lworkl, info); - } -} - -void arpackAUPD(options const & opt, - a_int * ido, char const * bMat, a_int nbDim, char const * which, complex * resid, complex * v, - a_int ldv, a_int * iparam, a_int * ipntr, complex * workd, complex * workl, a_int lworkl, double * & rwork, - a_int * info) { - if (!rwork) rwork = new double[opt.nbCV]; - znaupd_c(ido, bMat, nbDim, which, opt.nbEV, opt.tol, reinterpret_cast<_Complex double*>(resid), opt.nbCV, - reinterpret_cast<_Complex double*>(v), ldv, iparam, ipntr, reinterpret_cast<_Complex double*>(workd), - reinterpret_cast<_Complex double*>(workl), lworkl, rwork, info); -} - -int arpackEUPD(options const & opt, arpackEV & out, - bool rvec, char const * howmny, a_int const * select, double * z, - a_int ldz, char const * bMat, a_int nbDim, char const * which, double * resid, double * v, - a_int ldv, a_int * iparam, a_int * ipntr, double * workd, double * workl, a_int lworkl, double * rwork, - a_int & info) { - assert(rwork == NULL); - if (opt.symPb) { - double * d = new double[opt.nbEV]; for (a_int k = 0; k < opt.nbEV; k++) d[k] = 0.; + // Read A and B matrices. - dseupd_c(rvec, howmny, select, d, z, ldz, opt.sigmaReal, - bMat, nbDim, which, opt.nbEV, opt.tol, resid, opt.nbCV, v, ldv, iparam, ipntr, workd, workl, lworkl, &info); - if (info == -14) cerr << "Error: dseupd - KO: dsaupd did not find any eigenvalues to sufficient accuracy" << endl; - if (info < 0 && info != -14 /*-14: don't break*/) {cerr << "Error: dseupd - KO with info " << info << endl; return 1;} + EM A; + auto start = chrono::high_resolution_clock::now(); + int rc = as.createMatrix(opt.fileA, A); + if (rc != 0) { + cerr << "Error: read A KO" << endl; + return rc; + } + auto stop = chrono::high_resolution_clock::now(); + double readATime = + chrono::duration_cast(stop - start).count() / 1000.; + cout << endl; + cout << "INP: create A " << readATime << " s" << endl; - // Arpack compute the whole spectrum. + if (opt.nbCV > A.cols()) opt.nbCV = A.cols(); /* Cut-off */ - a_int nbConv = iparam[4]; - out.val.reserve(nbConv); - for (a_int i = 0; d && i < nbConv; i++) { - complex lambda(d[i], 0.); - out.val.push_back(lambda); - if (out.val.size() == (size_t) opt.nbEV) break; // If more converged than requested, likely not accurate (check KO). + EM B; + if (!opt.stdPb) { + start = chrono::high_resolution_clock::now(); + rc = as.createMatrix(opt.fileB, B); + if (rc != 0) { + cerr << "Error: read B KO" << endl; + return rc; } + stop = chrono::high_resolution_clock::now(); + double readBTime = + chrono::duration_cast(stop - start).count() / + 1000.; + cout << endl; + cout << "INP: create B " << readBTime << " s" << endl; - out.vec.reserve(nbConv); - for (a_int i = 0; z && i < nbConv; i++) { - EigVecR V = EigMpVR(z + i*nbDim, nbDim); - out.vec.push_back(V.cast>()); - if (out.vec.size() == (size_t) opt.nbEV) break; // If more converged than requested, likely not accurate (check KO). + if (A.rows() != B.rows()) { + cerr << "Error: A.rows() != B.rows()" << endl; + return rc; } - - if (d) {delete [] d; d = NULL;} - } - else { - double * dr = new double[opt.nbEV+1]; for (a_int k = 0; k < opt.nbEV+1; k++) dr[k] = 0.; - double * di = new double[opt.nbEV+1]; for (a_int k = 0; k < opt.nbEV+1; k++) di[k] = 0.; - double * workev = new double[3*opt.nbCV]; - - dneupd_c(rvec, howmny, select, dr, di, z, ldz, opt.sigmaReal, opt.sigmaImag, workev, - bMat, nbDim, which, opt.nbEV, opt.tol, resid, opt.nbCV, v, ldv, iparam, ipntr, workd, workl, lworkl, &info); - if (info == -14) cerr << "Error: dneupd - KO: [dz]naupd did not find any eigenvalues to sufficient accuracy" << endl; - if (info < 0 && info != -14 /*-14: don't break*/) {cerr << "Error: dneupd - KO with info " << info << endl; return 1;} - - // Arpack compute only half of the spectrum. - - a_int nbConv = iparam[4]; - out.val.reserve(nbConv); - for (a_int i = 0; dr && di && i <= nbConv/2; i++) { // Scan first half of the spectrum. - // Get first half of the spectrum. - - complex lambda(dr[i], di[i]); - out.val.push_back(lambda); - if (out.val.size() == (size_t) opt.nbEV) break; // If more converged than requested, likely not accurate (check KO). - - // Deduce second half of the spectrum. - - out.val.push_back(complex(lambda.real(), -1.*lambda.imag())); - if (out.val.size() == (size_t) opt.nbEV) break; // If more converged than requested, likely not accurate (check KO). + if (A.cols() != B.cols()) { + cerr << "Error: A.cols() != B.cols()" << endl; + return rc; } + } - out.vec.reserve(nbConv); - for (a_int i = 0; z && i <= nbConv/2; i++) { // Scan half spectrum. - // Get first half of the spectrum. - - EigVecR Vr = EigMpVR(z + (2*i+0)*nbDim, nbDim); // Real part. - EigVecR Vi = EigMpVR(z + (2*i+1)*nbDim, nbDim); // Imaginary part. - complex imag(0., 1.); - EigVecC V = Vr.cast>() + imag * Vi.cast>(); - out.vec.push_back(V); - if (out.vec.size() == (size_t) opt.nbEV) break; // If more converged than requested, likely not accurate (check KO). - - // Deduce second half of the spectrum. + // Solve. - V = Vr.cast>() - imag * Vi.cast>(); - out.vec.push_back(V); - if (out.vec.size() == (size_t) opt.nbEV) break; // If more converged than requested, likely not accurate (check KO). + rc = as.solve(A, opt.stdPb ? nullptr : &B); + if (rc != 0) { + cerr << "Error: solve KO" << endl; + return rc; + } + if (opt.check) { + rc = as.checkEigVec(A, opt.stdPb ? nullptr : &B); + if (rc != 0) { + cerr << "Error: check KO" << endl; + return rc; } - - if (workev) {delete [] workev; workev = NULL;} - if (dr) {delete [] dr; dr = NULL;} - if (di) {delete [] di; di = NULL;} } - return 0; -} - -int arpackEUPD(options const & opt, arpackEV & out, - bool rvec, char const * howmny, a_int const * select, complex * z, - a_int ldz, char const * bMat, a_int nbDim, char const * which, complex * resid, complex * v, - a_int ldv, a_int * iparam, a_int * ipntr, complex * workd, complex * workl, a_int lworkl, double * rwork, - a_int & info) { - complex * d = new complex[opt.nbEV+1]; for (a_int k = 0; k < opt.nbEV+1; k++) d[k] = complex(0., 0.); - complex * workev = new complex[2*opt.nbCV]; - - complex sigma = complex(opt.sigmaReal, opt.sigmaImag); - zneupd_c(rvec, howmny, select, reinterpret_cast<_Complex double*>(d), reinterpret_cast<_Complex double*>(z), ldz, - reinterpret_cast<_Complex double &>(sigma), reinterpret_cast<_Complex double*>(workev), - bMat, nbDim, which, opt.nbEV, opt.tol, reinterpret_cast<_Complex double*>(resid), opt.nbCV, - reinterpret_cast<_Complex double*>(v), ldv, iparam, ipntr, - reinterpret_cast<_Complex double*>(workd), reinterpret_cast<_Complex double*>(workl), lworkl, rwork, &info); - if (info == -14) cerr << "Error: zneupd - KO: dsaupd did not find any eigenvalues to sufficient accuracy" << endl; - if (info < 0 && info != -14 /*-14: don't break*/) {cerr << "Error: zneupd - KO with info " << info << endl; return 1;} - - // Arpack compute the whole spectrum. - - a_int nbConv = iparam[4]; - out.val.reserve(nbConv); - for (a_int i = 0; d && i < nbConv; i++) { - complex lambda = d[i]; - out.val.push_back(lambda); - if (out.val.size() == (size_t) opt.nbEV) break; // If more converged than requested, likely not accurate (check KO). - } - - out.vec.reserve(nbConv); - for (a_int i = 0; z && i < nbConv; i++) { - EigVecC V = EigMpVC(z + i*nbDim, nbDim); - out.vec.push_back(V); - if (out.vec.size() == (size_t) opt.nbEV) break; // If more converged than requested, likely not accurate (check KO). - } + // Retrieve outputs. - if (workev) {delete [] workev; workev = NULL;} - if (d) {delete [] d; d = NULL;} + out.nbVal = as.val.size(); + out.mode = as.mode; + out.nbIt = as.nbIt; + out.imsTime = as.imsTime; + out.rciTime = as.rciTime; return 0; } -template int arpackMode(options const & opt, int const mode, - EigMatR const & A, EigMatR const & B, SLV & solver) { +template +int drtSolve(options& opt, output& out) { int rc = 1; - if (mode == 1) { - rc = 0; - } - else if (mode == 2 || mode == 3) { - if (mode == 2) { // Regular mode. - solver.compute(B); - } - else { // Shift invert mode. - if (!opt.shiftImag) { // Real shift only. - double sigma = opt.sigmaReal; - auto S = A - sigma * B; - solver.compute(S); - } - else { // Complex (real/imaginary) shift. - complex sigma(opt.sigmaReal, opt.sigmaImag); - auto S = A.cast>() - sigma * B.cast>(); - solver.compute(S.real()); // Real part of shifted matrix. - } - } - - if (solver.info() != Eigen::Success) {cerr << "Error: decomposition KO - check A and/or B are invertible" << endl; return 1;} - rc = 0; - } - else {cerr << "Error: arpack mode must be 1, 2 or 3 - KO" << endl; rc = 1;} + if (opt.slv == "LU") rc = drtSolve(opt, out); + if (opt.slv == "QR") rc = drtSolve(opt, out); + if (opt.slv == "LLT") rc = drtSolve(opt, out); + if (opt.slv == "LDLT") rc = drtSolve(opt, out); return rc; } -template int arpackMode(options const & opt, int const mode, - EigMatC const & A, EigMatC const & B, SLV & solver) { +template +int itrSolve(options& opt, output& out) { int rc = 1; - if (mode == 1) { - rc = 0; + stringstream clo(opt.slvItrPC); + string slvItrPC; + getline(clo, slvItrPC, '#'); + + double slvItrILUDropTol = 1.; + if (slvItrPC == "ILU") { + string dropTol; + getline(clo, dropTol, '#'); + stringstream dt(dropTol); + dt >> slvItrILUDropTol; + } + + int slvItrILUFillFactor = 2; + if (slvItrPC == "ILU") { + string fillFactor; + getline(clo, fillFactor); + stringstream ff(fillFactor); + ff >> slvItrILUFillFactor; } - else if (mode == 2 || mode == 3) { - if (mode == 2) { // Regular mode. - solver.compute(B); - } - else { // Shift invert mode. - complex sigma(opt.sigmaReal, opt.sigmaImag); - auto S = A - sigma * B; - solver.compute(S); - } - if (solver.info() != Eigen::Success) {cerr << "Error: decomposition KO - check A and/or B are invertible" << endl; return 1;} - rc = 0; + if (opt.slv == "BiCG") { + if (slvItrPC == "Diag") + rc = itrSolve(opt, out, slvItrILUDropTol, + slvItrILUFillFactor); + if (slvItrPC == "ILU") + rc = itrSolve(opt, out, slvItrILUDropTol, + slvItrILUFillFactor); + } + if (opt.slv == "CG") { + if (slvItrPC == "Diag") + rc = itrSolve(opt, out, slvItrILUDropTol, + slvItrILUFillFactor); + if (slvItrPC == "ILU") + rc = itrSolve(opt, out, slvItrILUDropTol, + slvItrILUFillFactor); } - else {cerr << "Error: arpack mode must be 1, 2 or 3 - KO" << endl; rc = 1;} return rc; } -template -int arpackSolve(options const & opt, int const & mode, - EM const & A, EM const & B, SLV & solver, arpackEV & out) { - // Arpack set up. - - // Note: all in/out parameters (all but work*) passed to d[sn][ae]upd are set to 0. before use. - // d[sn][ae]upd uses dgetv0 to generate a random starting vector (when info is initialized to 0). - // dgetv0 rely on resid/v: resid/v should be initialized to 0.0 to avoid "bad" starting random vectors. - - char const * which = opt.mag.c_str(); - a_int ido = 0; // First call to arpack. - char const * iMat = "I"; - char const * gMat = "G"; - char const * bMat = (mode == 1) ? iMat : gMat; - a_int nbDim = A.rows(); - RC zero; makeZero(zero); - RC * resid = new RC[nbDim]; for (a_int n = 0; n < nbDim; n++) resid[n] = zero; // Avoid "bad" starting vector. - if (opt.restart) { - ifstream rfs("resid.out"); - if (rfs.is_open()) { - for (a_int n = 0; n < nbDim; n++) rfs >> resid[n]; - if (opt.verbose >= 2) { - cout << endl; - cout << "resid:" << endl; - for (a_int n = 0; n < nbDim; n++) cout << resid[n] << endl; - cout << endl; - } - } - } - a_int ldv = nbDim; - RC * v = new RC[ldv*opt.nbCV]; for (a_int n = 0; n < ldv*opt.nbCV; n++) v[n] = zero; // Avoid "bad" starting vector. - if (opt.restart) { - ifstream vfs("v.out"); - if (vfs.is_open()) { - a_int nbCV = 0; vfs >> nbCV; if (opt.nbCV < nbCV) nbCV = opt.nbCV; - for (a_int n = 0; n < ldv*nbCV; n++) vfs >> v[n]; - if (opt.verbose >= 2) { - cout << endl; - cout << "v:" << endl; - for (a_int n = 0; n < ldv*nbCV; n++) cout << v[n] << endl; - cout << endl; - } - } - } - a_int iparam[11]; - iparam[0] = 1; // Use exact shifts (=> we'll never have ido == 3). - iparam[2] = opt.maxIt; // Maximum number of iterations. - iparam[3] = 1; // Block size. - iparam[4] = 0; // Number of ev found by arpack. - iparam[6] = mode; - int rc = arpackMode(opt, mode, A, B, solver); - if (rc != 0) {cerr << "Error: bad arpack mode" << endl; return rc;} - a_int ipntr[14]; - RC * workd = new RC[3*nbDim]; - a_int lworkl = opt.symPb ? opt.nbCV*opt.nbCV + 8*opt.nbCV : 3*opt.nbCV*opt.nbCV + 6*opt.nbCV; - lworkl++; // The documentation says "LWORKL must be at least ..." - RC * workl = new RC[lworkl]; - a_int info = 0; // Use random initial residual vector. - if (opt.restart) info = 1; - - // Arpack solve. - - double * rwork = NULL; - do { - // Call arpack. - - arpackAUPD(opt, &ido, bMat, nbDim, which, resid, v, ldv, iparam, ipntr, workd, workl, lworkl, rwork, &info); - if (info == 1) cerr << "Error: [dz][sn]aupd - KO: maximum number of iterations taken. Increase --maxIt..." << endl; - if (info == 3) cerr << "Error: [dz][sn]aupd - KO: no shifts could be applied. Increase --nbCV..." << endl; - if (info == -9) cerr << "Error: [dz][sn]aupd - KO: starting vector is zero. Retry: play with shift..." << endl; - if (info < 0) {cerr << "Error: [dz][sn]aupd - KO with info " << info << ", nbIt " << iparam[2] << endl; return 1;} - - // Reverse Communication Interface: perform actions according to arpack. - - auto start = chrono::high_resolution_clock::now(); - - a_int xIdx = ipntr[0] - 1; // 0-based (Fortran is 1-based). - a_int yIdx = ipntr[1] - 1; // 0-based (Fortran is 1-based). - - EV X(workd + xIdx, nbDim); // Arpack provides X. - EV Y(workd + yIdx, nbDim); // Arpack provides Y. - - if (ido == -1) { - if (iparam[6] == 1) { - Y = A * X; - } - else if (iparam[6] == 2) { - Y = A * X; - auto YY = Y; // Use copy of Y (not Y) for solve (avoid potential memory overwrite as Y is both in/out). - Y = solver.solve(YY); // Y = B^-1 * A * X. - if(solver.info() != Eigen::Success) { - cerr << "Error: solve KO - play with solver parameters (tol, max it, ...), or, change --slv" << endl; - return 1; - } - } - else if (iparam[6] == 3) { - auto Z = B * X; // Z = B * X. - Y = solver.solve(Z); // Y = (A - sigma * B)^-1 * B * X. - if(solver.info() != Eigen::Success) { - cerr << "Error: solve KO - play with solver parameters (tol, max it, ...), or, change --slv" << endl; - return 1; - } - } - } - else if (ido == 1) { - if (iparam[6] == 1) { - Y = A * X; - } - else if (iparam[6] == 2) { - Y = A * X; - if (opt.symPb) X = Y; // Remark 5 in dsaupd documentation. - auto YY = Y; // Use copy of Y (not Y) for solve (avoid potential memory overwrite as Y is both in/out). - Y = solver.solve(YY); // Y = B^-1 * A * X. - if(solver.info() != Eigen::Success) { - cerr << "Error: solve KO - play with solver parameters (tol, max it, ...), or, change --slv" << endl; - return 1; - } - } - else if (iparam[6] == 3) { - a_int zIdx = ipntr[2] - 1; // 0-based (Fortran is 1-based). - EV Z(workd + zIdx, nbDim); // Arpack provides Z. - Y = solver.solve(Z); // Y = (A - sigma * B)^-1 * B * X. - if(solver.info() != Eigen::Success) { - cerr << "Error: solve KO - play with solver parameters (tol, max it, ...), or, change --slv" << endl; - return 1; - } - } - } - else if (ido == 2) { - if (iparam[6] == 1) Y = X; // Y = I * X. - else if (iparam[6] == 2) Y = B * X; // Y = B * X. - else if (iparam[6] == 3) Y = B * X; // Y = B * X. - } - else if (ido != 99) {cerr << "Error: unexpected ido " << ido << " - KO" << endl; return 1;} - - auto stop = chrono::high_resolution_clock::now(); - out.rciTime += chrono::duration_cast(stop - start).count()/1000.; - - } while (ido != 99); - - // Get arpack results (computed eigen values and vectors). - - out.nbIt = iparam[2]; // Actual number of iterations. - bool rvec = true; - char const * howmnyA = "A"; // Ritz vectors. - char const * howmnyP = "P"; // Schur vectors. - char const * howmny = opt.schur ? howmnyP : howmnyA; - a_int * select = new a_int[opt.nbCV]; for (a_int n = 0; n < opt.nbCV; n++) select[n] = 1; - a_int const nbZ = nbDim*(opt.nbEV+1); // Caution: opt.nbEV+1 for dneupd. - RC * z = new RC[nbZ]; for (a_int n = 0; n < nbZ; n++) z[n] = zero; - a_int ldz = nbDim; - rc = arpackEUPD(opt, out, rvec, howmny, select, z, ldz, bMat, nbDim, which, resid, v, ldv, iparam, ipntr, workd, workl, lworkl, rwork, info); - if (rc != 0) {cerr << "Error: bad arpack eupd" << endl; return rc;} - - ofstream rfs("resid.out"); for (a_int n = 0; n < nbDim; n++) rfs << resid[n] << endl; - ofstream vfs("v.out"); vfs << opt.nbCV << endl; for (a_int n = 0; n < ldv*opt.nbCV; n++) vfs << v[n] << endl; - - // Clean. - - if (rwork) {delete [] rwork; rwork = NULL;} - if (z) {delete [] z; z = NULL;} - if (select) {delete [] select; select = NULL;} - if (workl) {delete [] workl; workl = NULL;} - if (workd) {delete [] workd; workd = NULL;} - if (v) {delete [] v; v = NULL;} - if (resid) {delete [] resid; resid = NULL;} - - return 0; -} - -template -int checkArpackEigVec(options const & opt, EM const & A, EM const & B, arpackEV const & out) { - // Check eigen vectors. - - string rs = opt.schur ? "Schur" : "Ritz"; - - if (opt.check && out.vec.size() == 0) { - cerr << "Error: no " << rs << " value / vector found" << endl; - return 1; - } - - for (size_t i = 0; i < out.vec.size(); i++) { - EigVecC V = out.vec[i]; - complex lambda = out.val[i]; - if (opt.verbose >= 1) { - cout << endl; - cout << rs << " value " << setw(3) << i << ": " << lambda << endl; - if (opt.verbose >= 2) { - cout << endl; - cout << rs << " vector " << setw(3) << i << " (norm " << V.norm() << "): " << endl; - cout << endl << V << endl; - } - } - - if (opt.check) { - EigVecC left = A.template cast>() * V; - EigVecC right = opt.stdPb ? V : B.template cast>() * V; - right *= lambda; - EigVecC diff = left - right; - if (diff.norm() > sqrt(opt.tol)) { - cerr << endl << "Error: bad vector " << setw(3) << i << " (norm " << V.norm() << "):" << endl; - cerr << endl << V << endl; - cerr << endl << "Error: left side (A*V - norm " << left.norm() << "):" << endl; - cerr << endl << left << endl; - cerr << endl << "Error: right side (lambda*" << (opt.stdPb ? "" : "B*") << "V - norm " << right.norm() << "):" << endl; - cerr << endl << right << endl; - cerr << endl << "Error: diff (norm " << diff.norm() << ", sqrt(tol) " << sqrt(opt.tol) << "):" << endl; - cerr << endl << diff << endl; - return 1; - } - else { - if (opt.verbose >= 1) { - cout << endl << rs << " value/vector " << setw(3) << i << ": check OK"; - cout << ", diff (norm " << diff.norm() << ", sqrt(tol) " << sqrt(opt.tol) << ")" << endl; - } - } - } - } - - return 0; -} - -void makeSigma(options const & opt, double & sigma) {sigma = opt.sigmaReal;} - -void makeSigma(options const & opt, complex & sigma) {sigma = complex(opt.sigmaReal, opt.sigmaImag);} - -template -int arpackSolve(options const & opt, EM & A, EM const & B, - SLV & solver, arpackEV & out) { - // If needed, transform the initial problem into a new one that arpack can handle. - - auto eps = numeric_limits::epsilon(); - bool shiftReal = (opt.shiftReal && fabs(opt.sigmaReal) > eps) ? true : false; - bool shiftImag = (opt.shiftImag && fabs(opt.sigmaImag) > eps) ? true : false; - - bool backTransform = false; - int mode = 0; - if (opt.stdPb) { - mode = 1; - if (shiftReal && !shiftImag) { - EM I(A.rows(), A.cols()); - I.setIdentity(); - RC sigma; makeSigma(opt, sigma); - A -= sigma*I; - backTransform = true; - } - } - else { - mode = 2; - if (shiftReal || shiftImag) mode = 3; - } - - // Solve the problem. - - if (opt.verbose >= 1) { - cout << endl; - cout << "ARP: mode " << mode; - cout << ", nbDim " << A.rows(); - cout << ", backTransform " << (backTransform ? "yes" : "no") << endl; - } - - int rc = arpackSolve(opt, mode, A, B, solver, out); - if (rc != 0) {cerr << "Error: arpack solve KO" << endl; return rc;} - - if (opt.verbose >= 1) { - cout << endl; - cout << "ARP: nbEV found " << out.val.size(); - cout << ", nbIt " << out.nbIt << endl; - } - - // If needed, transform back the arpack problem into the initial problem. +int main(int argc, char** argv) { + // Check for options. - if (backTransform) { - for (size_t i = 0; i < out.val.size(); i++) out.val[i] += opt.sigmaReal; - EM I(A.rows(), A.cols()); - I.setIdentity(); - RC sigma; makeSigma(opt, sigma); - A += sigma*I; // For later checks. + options opt; + int rc = opt.readCmdLine(argc, argv); + if (rc != 0) { + cerr << "Error: read cmd line KO" << endl; + return rc; } + cout << opt; // Print options. - // Check. - - return checkArpackEigVec(opt, A, B, out); -} - -template -int arpackSolve(options & opt, SLV & solver) { - // Read A. - - EM A; - int rc = readMatrixMarket(opt.fileA, A, opt.verbose, "A:"); - if (rc != 0) {cerr << "Error: read A KO" << endl; return rc;} - - // Read B. - - EM B; - if (!opt.stdPb) { - rc = readMatrixMarket(opt.fileB, B, opt.verbose, "B:"); - if (rc != 0) {cerr << "Error: read B KO" << endl; return rc;} - } + // Solve with arpack. - // Check A-B compatibility. + sstats_c(); // Reset timers. + sstatn_c(); // Reset timers. + cstatn_c(); // Reset timers. + + bool itrSlv = true; // Use iterative solvers. + if (opt.slv.find("LU") != string::npos || + opt.slv.find("QR") != string::npos || + opt.slv.find("LLT") != string::npos || + opt.slv.find("LDLT") != string::npos) + itrSlv = false; - if (!opt.stdPb) { - if (A.rows() != B.rows()) {cerr << "Error: A.rows() != B.rows()" << endl; return rc;} - if (A.cols() != B.cols()) {cerr << "Error: A.cols() != B.cols()" << endl; return rc;} + output out; + auto start = chrono::high_resolution_clock::now(); + if (opt.dense) { + if (itrSlv) { + cerr << "Error: dense matrices does not support iterative solvers" + << endl; + return 1; + } + + if (opt.simplePrec) { + if (opt.cpxPb) { + if (opt.denseRR) { + rc = drtSolve, float, EigDMxC, EigDFLUC, EigDFQRC, + EigDLLTC, EigDLDLTC>(opt, out); + } else { + rc = drtSolve, float, EigDMxC, EigDPLUC, EigDPQRC, + EigDLLTC, EigDLDLTC>(opt, out); + } + } else { + if (opt.denseRR) { + rc = drtSolve(opt, out); + } else { + rc = drtSolve(opt, out); + } + } + } else { + if (opt.cpxPb) { + if (opt.denseRR) { + rc = drtSolve, double, EigDMxZ, EigDFLUZ, EigDFQRZ, + EigDLLTZ, EigDLDLTZ>(opt, out); + } else { + rc = drtSolve, double, EigDMxZ, EigDPLUZ, EigDPQRZ, + EigDLLTZ, EigDLDLTZ>(opt, out); + } + } else { + if (opt.denseRR) { + rc = drtSolve(opt, out); + } else { + rc = drtSolve(opt, out); + } + } + } + } else { + if (opt.simplePrec) { + if (opt.cpxPb) { + if (itrSlv) { + rc = itrSolve, float, EigSMxC, EigSBiCGC, EigSBiCGILUC, + EigSCGC, EigSCGILUC>(opt, out); + } else { + rc = drtSolve, float, EigSMxC, EigSLUC, EigSQRC, + EigSLLTC, EigSLDLTC>(opt, out); + } + } else { + if (itrSlv) { + rc = itrSolve(opt, out); + } else { + rc = drtSolve(opt, out); + } + } + } else { + if (opt.cpxPb) { + if (itrSlv) { + rc = itrSolve, double, EigSMxZ, EigSBiCGZ, + EigSBiCGILUZ, EigSCGZ, EigSCGILUZ>(opt, out); + } else { + rc = drtSolve, double, EigSMxZ, EigSLUZ, EigSQRZ, + EigSLLTZ, EigSLDLTZ>(opt, out); + } + } else { + if (itrSlv) { + rc = itrSolve(opt, out); + } else { + rc = drtSolve(opt, out); + } + } + } + } + if (rc != 0) { + cerr << "Error: arpack solve KO" << endl; + return rc; } - if (opt.nbCV > A.cols()) opt.nbCV = A.cols(); // Cut-off. - // Arpack solve. + // Output results and stats. - arpackEV out; - out.rciTime = 0.; - auto start = chrono::high_resolution_clock::now(); - rc = arpackSolve(opt, A, B, solver, out); - if (rc != 0) {cerr << "Error: arpack solve KO" << endl; return rc;} auto stop = chrono::high_resolution_clock::now(); - double fullTime = chrono::duration_cast(stop - start).count()/1000.; + double fullTime = + chrono::duration_cast(stop - start).count() / 1000.; cout << endl; - cout << "OUT: nb EV found " << out.val.size() << ", nb iterations " << out.nbIt << endl; - cout << "OUT: full time " << fullTime << " s, RCI time " << out.rciTime << " s" << endl; - - return 0; -} - -template -int arpackSolve(options & opt) { - // Solve with arpack. - - int rc = 0; - if (opt.slv == "BiCG") { - SLVBCG solver; - if (opt.slvItrTol) solver.setTolerance(*opt.slvItrTol); - if (opt.slvItrMaxIt) solver.setMaxIterations(*opt.slvItrMaxIt); - rc = arpackSolve(opt, solver); - } - else if (opt.slv == "CG") { - SLVCG solver; - if (opt.slvItrTol) solver.setTolerance(*opt.slvItrTol); - if (opt.slvItrMaxIt) solver.setMaxIterations(*opt.slvItrMaxIt); - rc = arpackSolve(opt, solver); - } - else if (opt.slv == "LU") { - SLVSLU solver; - if (opt.slvDrtPvtThd) solver.setPivotThreshold(*opt.slvDrtPvtThd); - rc = arpackSolve(opt, solver); - } - else if (opt.slv == "QR") { - SLVSQR solver; - if (opt.slvDrtPvtThd) solver.setPivotThreshold(*opt.slvDrtPvtThd); - rc = arpackSolve(opt, solver); - } - else {cerr << "Error: unknown solver - KO" << endl; return 1;} - if (rc != 0) {cerr << "Error: arpack solve KO" << endl; return rc;} - - return 0; -} - -int main(int argc, char ** argv) { - // Check for options. - - options opt; - int rc = opt.readCmdLine(argc, argv); - if (rc != 0) {cerr << "Error: read cmd line KO" << endl; return rc;} - cout << opt; // Print options. - - if (opt.cpxPb) rc = arpackSolve, EigMatC, EigCooC, EigMpVC, EigBiCGC, EigCGC, EigSLUC, EigSQRC>(opt); - else rc = arpackSolve< double , EigMatR, EigCooR, EigMpVR, EigBiCGR, EigCGR, EigSLUR, EigSQRR>(opt); - if (rc != 0) {cerr << "Error: arpack solve KO" << endl; return rc;} + cout << "OUT: mode " << out.mode << ", nb EV found " << out.nbVal + << ", nb iterations " << out.nbIt << endl; + cout << "OUT: init mode solver " << out.imsTime << " s, RCI time " + << out.rciTime << " s" << endl; + cout << "OUT: full time " << fullTime << " s" << endl; + + a_int nopx = 0, nbx = 0, nrorth = 0, nitref = 0, nrstrt = 0; + float tsaupd = 0., tsaup2 = 0., tsaitr = 0., tseigt = 0., tsgets = 0., + tsapps = 0., tsconv = 0.; + float tnaupd = 0., tnaup2 = 0., tnaitr = 0., tneigt = 0., tngets = 0., + tnapps = 0., tnconv = 0.; + float tcaupd = 0., tcaup2 = 0., tcaitr = 0., tceigt = 0., tcgets = 0., + tcapps = 0., tcconv = 0.; + float tmvopx = 0., tmvbx = 0., tgetv0 = 0., titref = 0., trvec = 0.; + stat_c(nopx, nbx, nrorth, nitref, nrstrt, tsaupd, tsaup2, tsaitr, tseigt, + tsgets, tsapps, tsconv, tnaupd, tnaup2, tnaitr, tneigt, tngets, tnapps, + tnconv, tcaupd, tcaup2, tcaitr, tceigt, tcgets, tcapps, tcconv, tmvopx, + tmvbx, tgetv0, titref, trvec); + cout << endl; + cout << "STAT: total number of user OP*x operation " + << nopx << endl; + cout << "STAT: total number of user B*x operation " + << nbx << endl; + cout << "STAT: total number of reorthogonalization steps taken " + << nrorth << endl; + cout << "STAT: total number of it. refinement steps in reorthogonalization " + << nitref << endl; + cout << "STAT: total number of restart steps " + << nrstrt << endl; return 0; } diff -Nru arpack-3.7.0/EXAMPLES/MATRIX_MARKET/arpackmm.sh arpack-3.8.0/EXAMPLES/MATRIX_MARKET/arpackmm.sh --- arpack-3.7.0/EXAMPLES/MATRIX_MARKET/arpackmm.sh 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/EXAMPLES/MATRIX_MARKET/arpackmm.sh 2020-12-07 10:40:45.000000000 +0000 @@ -1,5 +1,12 @@ #!/bin/bash -eu +export CMD="./arpackmm --help" # For coverage +echo "$CMD" +eval "$CMD &> arpackmm.run.log" +echo "" +echo "========================================================================================" +echo "" + for eigPb in "--A As.mtx" "--nonSymPb --A An.mtx" "--nonSymPb --cpxPb --A Az.mtx --B Bz.mtx" do for genPb in "" "--genPb" @@ -9,13 +16,13 @@ export shiftOpt="" if [[ "$eigPb" == *nonSymPb* ]]; then if [[ "$genPb" == *genPb* ]]; then - export shiftOpt="--shiftReal 2.5 --shiftImag 2.5 --tol 0.5" # Relax tolerance, tricky to converge. + continue # Skip to ensure stable test: tricky to convergence. else export shiftOpt="--shiftReal 100.0 --shiftImag 100.0" fi else if [[ "$genPb" == *genPb* ]]; then - export shiftOpt="--shiftReal 50.0" + continue # Skip to ensure stable test: tricky to convergence. else export shiftOpt="--shiftReal 100.0" fi @@ -27,36 +34,58 @@ do for tol in "" "--tol 1.e-5" do - for slv in "" "--slv CG --slvItrTol 1.e-06 --slvItrMaxIt 100" "--slv LU --slvDrtPvtThd 1.e-06" "--slv QR" + for slv in "--slv BiCG --slvItrTol 1.e-06 --slvItrMaxIt 150" "--slv CG --slvItrTol 1.e-06 --slvItrMaxIt 150" \ + "--slv BiCG --slvItrPC ILU" "--slv CG --slvItrPC ILU#1.e-06#2" \ + "--slv LU" "--slv QR --slvDrtPivot 1.e-06" \ + "--slv LLT" "--slv LLT --slvDrtOffset 0." \ + "--slv LDLT" "--slv LDLT --slvDrtScale 1." do for rs in "" "--schur" do - export extraGenPb="" - if [[ "$genPb" == *genPb* ]]; then - export extraGenPb="$shiftOpt" # Force shift if genPb. - fi - - if [[ "$slv" == *CG* ]]; then - if [[ "$eigPb" == *nonSymPb* ]]; then - continue # Skip CG that could fail (CG is meant to deal with sym matrices). - fi - fi - - # Run arpackmm: use --nbCV 6 to ease convergence, and, --verbose 3 for debug. - export CMD="./arpackmm $eigPb $genPb $smallMag $shiftRI $invert $tol $slv $extraGenPb $rs --nbCV 6 --verbose 3" - echo "$CMD" - eval "$CMD" - echo "" - echo "========================================================================================" - echo "" - - # Run arpackmm: re-run with restart. - export CMD="$CMD --restart" - echo "$CMD" - eval "$CMD" - echo "" - echo "========================================================================================" - echo "" + for dsPrec in "" "--simplePrec" + do + for dsMat in "" "--dense false" "--dense true" + do + export extraGenPb="" + if [[ "$genPb" == *genPb* ]]; then + export extraGenPb="$shiftOpt" # Force shift if genPb. + fi + + if [[ "$slv" == *CG* ]]; then + if [[ "$eigPb" == *nonSymPb* ]]; then + continue # Skip CG that could fail (CG is meant to deal with sym matrices). + fi + fi + + if [[ "$slv" == *LLT* ]] || [[ "$slv" == *LDLT* ]]; then + if [[ "$eigPb" == *nonSymPb* ]] || [[ "$genPb" == *genPb* ]]; then + continue # Skip LLT/LDLT that could fail (LLT/LDLT are meant to deal with SPD matrices). + fi + fi + + if [[ "$dsMat" == *dense* ]]; then + if [[ "$slv" == *CG* ]]; then + continue # Iterative solvers are not allowed when using dense matrices. + fi + fi + + # Run arpackmm: use --nbCV 6 and --maxIt 200 to ease convergence, and, --verbose 3 for debug. + export CMD="./arpackmm $eigPb $genPb $smallMag $shiftRI $invert $tol $slv $rs $dsPrec $dsMat $extraGenPb --nbCV 6 --maxIt 200 --verbose 3 --debug 3" + echo "$CMD" + eval "$CMD &> arpackmm.run.log" + echo "" + echo "========================================================================================" + echo "" + + # Run arpackmm: re-run with restart. + export CMD="$CMD --restart" + echo "$CMD" + eval "$CMD &> arpackmm.run.log" + echo "" + echo "========================================================================================" + echo "" + done + done done done done diff -Nru arpack-3.7.0/EXAMPLES/MATRIX_MARKET/arpackSolver.hpp arpack-3.8.0/EXAMPLES/MATRIX_MARKET/arpackSolver.hpp --- arpack-3.7.0/EXAMPLES/MATRIX_MARKET/arpackSolver.hpp 1970-01-01 00:00:00.000000000 +0000 +++ arpack-3.8.0/EXAMPLES/MATRIX_MARKET/arpackSolver.hpp 2020-12-07 10:40:45.000000000 +0000 @@ -0,0 +1,1119 @@ +#ifndef __ARPACKSOLVER_HPP__ +#define __ARPACKSOLVER_HPP__ + +#include "arpack.h" + +#include +#include +#include // stringstream. +#include // [io]fstream. +#include +#include // setw. +#include +#include +#include // is_same. + +#include +#include +#include +#include +#include +#include +#include +#include +#include + +using namespace std; + +// Sparse matrix related types. + +typedef Eigen::SparseMatrix< float> EigSMxS; // Real. +typedef Eigen::SparseMatrix< double> EigSMxD; // Real. +typedef Eigen::SparseMatrix> EigSMxC; // Complex. +typedef Eigen::SparseMatrix> EigSMxZ; // Complex. + +// Iterative solvers for sparse matrices. + +typedef Eigen::BiCGSTAB EigSBiCGS; // Real. +typedef Eigen::BiCGSTAB EigSBiCGD; // Real. +typedef Eigen::BiCGSTAB EigSBiCGC; // Complex. +typedef Eigen::BiCGSTAB EigSBiCGZ; // Complex. + +typedef Eigen::ConjugateGradient EigSCGS; // Real. +typedef Eigen::ConjugateGradient EigSCGD; // Real. +typedef Eigen::ConjugateGradient EigSCGC; // Complex. +typedef Eigen::ConjugateGradient EigSCGZ; // Complex. + +typedef Eigen::IncompleteLUT< float> EigILUS; // Real. +typedef Eigen::IncompleteLUT< double> EigILUD; // Real. +typedef Eigen::IncompleteLUT> EigILUC; // Complex. +typedef Eigen::IncompleteLUT> EigILUZ; // Complex. + +typedef Eigen::BiCGSTAB EigSBiCGILUS; // Real. +typedef Eigen::BiCGSTAB EigSBiCGILUD; // Real. +typedef Eigen::BiCGSTAB EigSBiCGILUC; // Complex. +typedef Eigen::BiCGSTAB EigSBiCGILUZ; // Complex. + +typedef Eigen::ConjugateGradient EigSCGILUS; // Real. +typedef Eigen::ConjugateGradient EigSCGILUD; // Real. +typedef Eigen::ConjugateGradient EigSCGILUC; // Complex. +typedef Eigen::ConjugateGradient EigSCGILUZ; // Complex. + +// Direct solvers for sparse matrices. + +typedef Eigen::SimplicialLLT > EigSLLTS; // Real. +typedef Eigen::SimplicialLLT > EigSLLTD; // Real. +typedef Eigen::SimplicialLLT > EigSLLTC; // Complex. +typedef Eigen::SimplicialLLT > EigSLLTZ; // Complex. + +typedef Eigen::SimplicialLDLT> EigSLDLTS; // Real. +typedef Eigen::SimplicialLDLT> EigSLDLTD; // Real. +typedef Eigen::SimplicialLDLT> EigSLDLTC; // Complex. +typedef Eigen::SimplicialLDLT> EigSLDLTZ; // Complex. + +typedef Eigen::SparseLU> EigSLUS; // Real. +typedef Eigen::SparseLU> EigSLUD; // Real. +typedef Eigen::SparseLU> EigSLUC; // Complex. +typedef Eigen::SparseLU> EigSLUZ; // Complex. + +typedef Eigen::SparseQR> EigSQRS; // Real. +typedef Eigen::SparseQR> EigSQRD; // Real. +typedef Eigen::SparseQR> EigSQRC; // Complex. +typedef Eigen::SparseQR> EigSQRZ; // Complex. + +// Dense matrix related types. + +typedef Eigen::Matrix< float, Eigen::Dynamic, Eigen::Dynamic> EigDMxS; // Real. +typedef Eigen::Matrix< double, Eigen::Dynamic, Eigen::Dynamic> EigDMxD; // Real. +typedef Eigen::Matrix, Eigen::Dynamic, Eigen::Dynamic> EigDMxC; // Complex. +typedef Eigen::Matrix, Eigen::Dynamic, Eigen::Dynamic> EigDMxZ; // Complex. + +// Direct solvers for dense matrices. + +typedef Eigen::LLT EigDLLTS; // Real. +typedef Eigen::LLT EigDLLTD; // Real. +typedef Eigen::LLT EigDLLTC; // Complex. +typedef Eigen::LLT EigDLLTZ; // Complex. + +typedef Eigen::LDLT EigDLDLTS; // Real. +typedef Eigen::LDLT EigDLDLTD; // Real. +typedef Eigen::LDLT EigDLDLTC; // Complex. +typedef Eigen::LDLT EigDLDLTZ; // Complex. + +typedef Eigen::FullPivLU EigDFLUS; // Real. +typedef Eigen::FullPivLU EigDFLUD; // Real. +typedef Eigen::FullPivLU EigDFLUC; // Complex. +typedef Eigen::FullPivLU EigDFLUZ; // Complex. + +typedef Eigen::FullPivHouseholderQR EigDFQRS; // Real. +typedef Eigen::FullPivHouseholderQR EigDFQRD; // Real. +typedef Eigen::FullPivHouseholderQR EigDFQRC; // Complex. +typedef Eigen::FullPivHouseholderQR EigDFQRZ; // Complex. + +typedef Eigen::PartialPivLU EigDPLUS; // Real. +typedef Eigen::PartialPivLU EigDPLUD; // Real. +typedef Eigen::PartialPivLU EigDPLUC; // Complex. +typedef Eigen::PartialPivLU EigDPLUZ; // Complex. + +typedef Eigen::HouseholderQR EigDPQRS; // Real. +typedef Eigen::HouseholderQR EigDPQRD; // Real. +typedef Eigen::HouseholderQR EigDPQRC; // Complex. +typedef Eigen::HouseholderQR EigDPQRZ; // Complex. + +// Definition of arpackSolver class. + +typedef Eigen::Matrix, Eigen::Dynamic, 1> EigVecZ; + +typedef vector> StdVecZ; +typedef vector StdVecEVZ; + +// RC: Real or Complex. +// FD: Float or Double. +// EM: Eigen Matrix (sparse or dense). +// SLV: Solver. +template +class arpackSolver { + // Nested typedef. + + typedef Eigen::Map> EV; + + // Public methods. + + public: + + arpackSolver() { + symPb = true; + nbEV = 1; + nbCV = 2*nbEV+1; + tol = 1.e-6; + sigmaReal = sigmaImag = 0.; + dumpToFile = false; + restartFromFile = false; + mag = "LM"; + maxIt = 100; + schur = false; + verbose = 0; + + stdPb = true; + mode = 1; + nbIt = 0; + imsTime = 0.; + rciTime = 0.; + + nbDim = 0; + resid = nullptr; + v = nullptr; + }; + + ~arpackSolver() { + if (v) {delete [] v; v = nullptr;} + if (resid) {delete [] resid; resid = nullptr;} + }; + + int createMatrix(string const & fileName, Eigen::SparseMatrix & M) { + // Read matrix from file. + + a_uint n = 0, m = 0; + vector i, j; + vector Mij; + int rc = readMatrixMarket(fileName, n, m, i, j, Mij); + if (rc != 0) {cerr << "Error: read matrix market file KO" << endl; return rc;} + + // Create matrix from file. + + M = Eigen::SparseMatrix(n, m); // Set matrice dimensions. + vector> triplets; + a_uint nnz = Mij.size(); + triplets.reserve(nnz); + for (size_t k = 0; k < nnz; k++) triplets.emplace_back(i[k], j[k], Mij[k]); + M.setFromTriplets(triplets.begin(), triplets.end()); // Set all (i, j, Mij). + + return 0; + }; + + int createMatrix(string const & fileName, Eigen::Matrix & M) { + // Read matrix from file. + + a_uint n = 0, m = 0; + vector i, j; + vector Mij; + int rc = readMatrixMarket(fileName, n, m, i, j, Mij); + if (rc != 0) {cerr << "Error: read matrix market file KO" << endl; return rc;} + + // Create matrix from file. + + M = Eigen::Matrix(n, m); // Set matrice dimensions. + M.setZero(n, m); // Avoid spurious/random values which may break solves (LU, QR, ...). + a_uint nnz = Mij.size(); + for (size_t k = 0; k < nnz; k++) M(i[k], j[k]) = Mij[k]; + + return 0; + }; + + void dumpParameters() { + if (verbose >= 1) { + cout << endl << "arpackSolver:" << endl; + cout << endl << "symPb: " << symPb << endl; + cout << endl << "nbEV: " << nbEV << endl; + cout << endl << "nbCV: " << nbCV << endl; + cout << endl << "tol: " << tol << endl; + cout << endl << "sigmaReal: " << sigmaReal << endl; + cout << endl << "sigmaImag: " << sigmaImag << endl; + cout << endl << "dumpToFile: " << dumpToFile << endl; + cout << endl << "restartFromFile: " << restartFromFile << endl; + cout << endl << "mag: " << mag << endl; + cout << endl << "maxIt: " << maxIt << endl; + cout << endl << "schur: " << schur << endl; + } + }; + + int solve(EM & A, EM const * B = nullptr) { + stdPb = !B ? true : false; + + dumpParameters(); + if (verbose == 3) { + cout << endl << "arpackSolver:" << endl; + cout << endl << "A:" << endl; + cout << endl << A << endl; + if (B) { + cout << endl << "B:" << endl; + cout << endl << *B << endl; + } + } + nbDim = A.rows(); + + // If needed, transform the initial problem into a new one that arpack can handle. + + auto eps = numeric_limits::epsilon(); + bool shiftReal = (fabs(sigmaReal) > eps) ? true : false; + bool shiftImag = (fabs(sigmaImag) > eps) ? true : false; + bool backTransform = false; + mode = 0; + if (stdPb) { + mode = 1; + if (shiftReal && !shiftImag) { + EM I(A.rows(), A.cols()); + I.setIdentity(); + RC sigma; makeSigma(sigma); + A -= sigma*I; + backTransform = true; + } + } + else { + mode = 2; + if (shiftReal || shiftImag) mode = 3; + } + if (verbose >= 1) { + cout << endl << "arpackSolver:" << endl; + cout << endl << "mode " << mode << ", backTransform " << (backTransform ? "yes" : "no") << endl; + } + + // Solve with arpack. + // Note: when initializing Eigen solvers, API differ depending on solvers. + + SLV solver; + int rc = initSolver(solver); + if (rc != 0) {cerr << "Error: initialize solver KO" << endl; return rc;} + rc = solve(A, B, solver); + if (rc != 0) {cerr << "Error: arpack solve KO" << endl; return rc;} + + // If needed, transform back the arpack problem into the initial problem. + + if (backTransform) { + EM I(A.rows(), A.cols()); + I.setIdentity(); + RC sigma; makeSigma(sigma); + A += sigma*I; + for (size_t i = 0; i < val.size(); i++) val[i] += sigma; + } + + return 0; + }; + + int checkEigVec(EM const & A, EM const * B = nullptr, double const * diffTol = nullptr) { + stdPb = !B ? true : false; + double dTol = !diffTol ? sqrt(tol) : *diffTol; + + // Check eigen vectors. + + string rs = schur ? "Schur" : "Ritz"; + + if (vec.size() == 0) { + cerr << "Error: no " << rs << " value / vector found" << endl; + return 1; + } + + for (size_t i = 0; i < vec.size(); i++) { + EigVecZ V = vec[i]; + complex lambda = val[i]; + if (verbose >= 1) { + cout << endl << "arpackSolver:" << endl; + cout << endl << rs << " value " << setw(3) << i << ": " << lambda << endl; + if (verbose >= 2) { + cout << endl << rs << " vector " << setw(3) << i << " (norm " << V.norm() << "): " << endl; + cout << endl << V << endl; + } + } + + EigVecZ left = A.template cast>() * V; + EigVecZ right = stdPb ? V : B->template cast>() * V; + right *= lambda; + EigVecZ diff = left - right; + if (diff.norm() > dTol) { + cerr << endl << "Error: bad vector " << setw(3) << i << " (norm " << V.norm() << "):" << endl; + cerr << endl << V << endl; + cerr << endl << "Error: left side (A*V - norm " << left.norm() << "):" << endl; + cerr << endl << left << endl; + cerr << endl << "Error: right side (lambda*" << (stdPb ? "" : "B*") << "V - norm " << right.norm() << "):" << endl; + cerr << endl << right << endl; + cerr << endl << "Error: diff (norm " << diff.norm() << ", tol " << dTol << "):" << endl; + cerr << endl << diff << endl; + return 1; + } + else { + if (verbose >= 1) { + cout << endl << "arpackSolver:" << endl; + cout << endl << rs << " value/vector " << setw(3) << i << ": check OK"; + cout << ", diff (norm " << diff.norm() << ", tol " << dTol << ")" << endl; + } + } + } + + return 0; + }; + + // Private methods. + + private: + + void makeZero( float & zero) {zero = 0.f;}; + + void makeZero( double & zero) {zero = 0.;}; + + void makeZero(complex< float> & zero) {zero = complex(0.f, 0.f);}; + + void makeZero(complex & zero) {zero = complex(0., 0.);}; + + int readMatrixMarket(string const & fileName, + a_uint & n, a_uint & m, vector & i, vector & j, vector & Mij) { + ifstream inp(fileName); + if (!inp) {cerr << "Error: can not open " << fileName << endl; return 1;} + + // Read matrix from file. + + a_uint l = 0, nnz = 0; + do { + // Skip comments. + + string inpLine; getline(inp, inpLine); l++; + while (isspace(*inpLine.begin())) inpLine.erase(inpLine.begin()); // Suppress leading white spaces. + if (inpLine.length() == 0) continue; // Empty line. + if (inpLine[0] == '%') continue; // Comments skipped, begin reading. + + // Read matrix market file. + + stringstream inpSS(inpLine); + if (n == 0 && m == 0) { // Header. + inpSS >> n >> m; + if (!inpSS) {cerr << "Error: bad header (n, m)" << endl; return 1;} + if (nnz == 0) { + inpSS >> nnz; + if (inpSS) { // OK, (optional) nnz has been provided. + i.reserve(nnz); + j.reserve(nnz); + Mij.reserve(nnz); + } + } + } + else { // Body. + a_uint k = 0, l = 0; + RC zero; makeZero(zero); + RC Mkl = zero; + inpSS >> k >> l >> Mkl; + if (!inpSS) {cerr << "Error: bad line (" << fileName << ", line " << l << ")" << endl; return 1;} + i.push_back(k); + j.push_back(l); + Mij.push_back(Mkl); + } + } + while (inp); + + // Handle 1-based -> 0-based. + + nnz = i.size(); // In case nnz was not provided. + if (*max_element(begin(i), end(i)) == n || *max_element(begin(j), end(j)) == m) { + for (size_t k = 0; k < nnz; k++) i[k] -= 1; + for (size_t k = 0; k < nnz; k++) j[k] -= 1; + } + + return 0; + }; + + void aupd(a_int * ido, char const * bMat, a_int nbDim, char const * which, float * resid, float * v, + a_int ldv, a_int * iparam, a_int * ipntr, float * workd, float * workl, a_int lworkl, float * & rwork, + a_int * info) { + assert(rwork == nullptr); + if (symPb) { + ssaupd_c(ido, bMat, nbDim, which, nbEV, tol, resid, nbCV, v, ldv, iparam, ipntr, workd, workl, lworkl, info); + } + else { + snaupd_c(ido, bMat, nbDim, which, nbEV, tol, resid, nbCV, v, ldv, iparam, ipntr, workd, workl, lworkl, info); + } + }; + + void aupd(a_int * ido, char const * bMat, a_int nbDim, char const * which, double * resid, double * v, + a_int ldv, a_int * iparam, a_int * ipntr, double * workd, double * workl, a_int lworkl, double * & rwork, + a_int * info) { + assert(rwork == nullptr); + if (symPb) { + dsaupd_c(ido, bMat, nbDim, which, nbEV, tol, resid, nbCV, v, ldv, iparam, ipntr, workd, workl, lworkl, info); + } + else { + dnaupd_c(ido, bMat, nbDim, which, nbEV, tol, resid, nbCV, v, ldv, iparam, ipntr, workd, workl, lworkl, info); + } + }; + + void aupd(a_int * ido, char const * bMat, a_int nbDim, char const * which, complex * resid, complex * v, + a_int ldv, a_int * iparam, a_int * ipntr, complex * workd, complex * workl, a_int lworkl, float * & rwork, + a_int * info) { + if (!rwork) rwork = new float[nbCV]; + cnaupd_c(ido, bMat, nbDim, which, nbEV, tol, reinterpret_cast<_Complex float*>(resid), nbCV, + reinterpret_cast<_Complex float*>(v), ldv, iparam, ipntr, reinterpret_cast<_Complex float*>(workd), + reinterpret_cast<_Complex float*>(workl), lworkl, rwork, info); + }; + + void aupd(a_int * ido, char const * bMat, a_int nbDim, char const * which, complex * resid, complex * v, + a_int ldv, a_int * iparam, a_int * ipntr, complex * workd, complex * workl, a_int lworkl, double * & rwork, + a_int * info) { + if (!rwork) rwork = new double[nbCV]; + znaupd_c(ido, bMat, nbDim, which, nbEV, tol, reinterpret_cast<_Complex double*>(resid), nbCV, + reinterpret_cast<_Complex double*>(v), ldv, iparam, ipntr, reinterpret_cast<_Complex double*>(workd), + reinterpret_cast<_Complex double*>(workl), lworkl, rwork, info); + }; + + void spectrum(RC * d, RC * z, a_int nbDim, a_int * iparam) { + // Arpack compute the whole spectrum. + + a_int nbConv = iparam[4]; + val.reserve(nbConv); + for (a_int i = 0; d && i < nbConv; i++) { + complex lambda(d[i]); + val.push_back(lambda); + if (val.size() == (size_t) nbEV) break; // If more converged than requested, likely not accurate (check KO). + } + + vec.reserve(nbConv); + for (a_int i = 0; z && i < nbConv; i++) { + EV V = EV(z + i*nbDim, nbDim); + vec.push_back(V.template cast>()); + if (vec.size() == (size_t) nbEV) break; // If more converged than requested, likely not accurate (check KO). + } + }; + + void halfSpectrum(RC * dr, RC * di, RC * z, a_int nbDim, a_int * iparam) { + // Arpack compute only half of the spectrum. + + a_int nbConv = iparam[4]; + val.reserve(nbConv); + for (a_int i = 0; dr && di && i <= nbConv/2; i++) { // Scan first half of the spectrum. + // Get first half of the spectrum. + + complex lambda(dr[i], di[i]); + val.push_back(lambda); + if (val.size() == (size_t) nbEV) break; // If more converged than requested, likely not accurate (check KO). + + // Deduce second half of the spectrum. + + val.push_back(complex(lambda.real(), -1.*lambda.imag())); + if (val.size() == (size_t) nbEV) break; // If more converged than requested, likely not accurate (check KO). + } + + vec.reserve(nbConv); + for (a_int i = 0; z && i <= nbConv/2; i++) { // Scan half spectrum. + // Get first half of the spectrum. + + EV Vr = EV(z + (2*i+0)*nbDim, nbDim); // Real part. + EV Vi = EV(z + (2*i+1)*nbDim, nbDim); // Imaginary part. + complex imag(0., 1.); + EigVecZ V = Vr.template cast>() + imag * Vi.template cast>(); + vec.push_back(V); + if (vec.size() == (size_t) nbEV) break; // If more converged than requested, likely not accurate (check KO). + + // Deduce second half of the spectrum. + + V = Vr.template cast>() - imag * Vi.template cast>(); + vec.push_back(V); + if (vec.size() == (size_t) nbEV) break; // If more converged than requested, likely not accurate (check KO). + } + }; + + int eupd(a_int rvec, char const * howmny, a_int const * select, float * z, + a_int ldz, char const * bMat, a_int nbDim, char const * which, float * resid, float * v, + a_int ldv, a_int * iparam, a_int * ipntr, float * workd, float * workl, a_int lworkl, float * rwork, + a_int & info) { + assert(rwork == nullptr); + if (symPb) { + float * d = new float[nbEV]; for (a_int k = 0; k < nbEV; k++) d[k] = 0.; + + sseupd_c(rvec, howmny, select, d, z, ldz, sigmaReal, + bMat, nbDim, which, nbEV, tol, resid, nbCV, v, ldv, iparam, ipntr, workd, workl, lworkl, &info); + if (info == -14) cerr << "Error: dseupd - KO: dsaupd did not find any eigenvalues to sufficient accuracy" << endl; + if (info < 0 && info != -14 /*-14: don't break*/) {cerr << "Error: dseupd - KO with info " << info << endl; return 1;} + + spectrum(d, z, nbDim, iparam); + + if (d) {delete [] d; d = nullptr;} + } + else { + float * dr = new float[nbEV+1]; for (a_int k = 0; k < nbEV+1; k++) dr[k] = 0.; + float * di = new float[nbEV+1]; for (a_int k = 0; k < nbEV+1; k++) di[k] = 0.; + float * workev = new float[3*nbCV]; + + sneupd_c(rvec, howmny, select, dr, di, z, ldz, sigmaReal, sigmaImag, workev, + bMat, nbDim, which, nbEV, tol, resid, nbCV, v, ldv, iparam, ipntr, workd, workl, lworkl, &info); + if (info == -14) cerr << "Error: dneupd - KO: [dz]naupd did not find any eigenvalues to sufficient accuracy" << endl; + if (info < 0 && info != -14 /*-14: don't break*/) {cerr << "Error: dneupd - KO with info " << info << endl; return 1;} + + halfSpectrum(dr, di, z, nbDim, iparam); + + if (workev) {delete [] workev; workev = nullptr;} + if (dr) {delete [] dr; dr = nullptr;} + if (di) {delete [] di; di = nullptr;} + } + + return 0; + }; + + int eupd(a_int rvec, char const * howmny, a_int const * select, double * z, + a_int ldz, char const * bMat, a_int nbDim, char const * which, double * resid, double * v, + a_int ldv, a_int * iparam, a_int * ipntr, double * workd, double * workl, a_int lworkl, double * rwork, + a_int & info) { + assert(rwork == nullptr); + if (symPb) { + double * d = new double[nbEV]; for (a_int k = 0; k < nbEV; k++) d[k] = 0.; + + dseupd_c(rvec, howmny, select, d, z, ldz, sigmaReal, + bMat, nbDim, which, nbEV, tol, resid, nbCV, v, ldv, iparam, ipntr, workd, workl, lworkl, &info); + if (info == -14) cerr << "Error: dseupd - KO: dsaupd did not find any eigenvalues to sufficient accuracy" << endl; + if (info < 0 && info != -14 /*-14: don't break*/) {cerr << "Error: dseupd - KO with info " << info << endl; return 1;} + + spectrum(d, z, nbDim, iparam); + + if (d) {delete [] d; d = nullptr;} + } + else { + double * dr = new double[nbEV+1]; for (a_int k = 0; k < nbEV+1; k++) dr[k] = 0.; + double * di = new double[nbEV+1]; for (a_int k = 0; k < nbEV+1; k++) di[k] = 0.; + double * workev = new double[3*nbCV]; + + dneupd_c(rvec, howmny, select, dr, di, z, ldz, sigmaReal, sigmaImag, workev, + bMat, nbDim, which, nbEV, tol, resid, nbCV, v, ldv, iparam, ipntr, workd, workl, lworkl, &info); + if (info == -14) cerr << "Error: dneupd - KO: [dz]naupd did not find any eigenvalues to sufficient accuracy" << endl; + if (info < 0 && info != -14 /*-14: don't break*/) {cerr << "Error: dneupd - KO with info " << info << endl; return 1;} + + halfSpectrum(dr, di, z, nbDim, iparam); + + if (workev) {delete [] workev; workev = nullptr;} + if (dr) {delete [] dr; dr = nullptr;} + if (di) {delete [] di; di = nullptr;} + } + + return 0; + }; + + int eupd(a_int rvec, char const * howmny, a_int const * select, complex * z, + a_int ldz, char const * bMat, a_int nbDim, char const * which, complex * resid, complex * v, + a_int ldv, a_int * iparam, a_int * ipntr, complex * workd, complex * workl, a_int lworkl, float * rwork, + a_int & info) { + complex * d = new complex[nbEV+1]; for (a_int k = 0; k < nbEV+1; k++) d[k] = complex(0., 0.); + complex * workev = new complex[2*nbCV]; + + complex sigma = complex((float) sigmaReal, (float) sigmaImag); + cneupd_c(rvec, howmny, select, reinterpret_cast<_Complex float*>(d), reinterpret_cast<_Complex float*>(z), ldz, + reinterpret_cast<_Complex float &>(sigma), reinterpret_cast<_Complex float*>(workev), + bMat, nbDim, which, nbEV, tol, reinterpret_cast<_Complex float*>(resid), nbCV, + reinterpret_cast<_Complex float*>(v), ldv, iparam, ipntr, + reinterpret_cast<_Complex float*>(workd), reinterpret_cast<_Complex float*>(workl), lworkl, rwork, &info); + if (info == -14) cerr << "Error: zneupd - KO: dsaupd did not find any eigenvalues to sufficient accuracy" << endl; + if (info < 0 && info != -14 /*-14: don't break*/) {cerr << "Error: zneupd - KO with info " << info << endl; return 1;} + + spectrum(d, z, nbDim, iparam); + + if (workev) {delete [] workev; workev = nullptr;} + if (d) {delete [] d; d = nullptr;} + + return 0; + }; + + int eupd(a_int rvec, char const * howmny, a_int const * select, complex * z, + a_int ldz, char const * bMat, a_int nbDim, char const * which, complex * resid, complex * v, + a_int ldv, a_int * iparam, a_int * ipntr, complex * workd, complex * workl, a_int lworkl, double * rwork, + a_int & info) { + complex * d = new complex[nbEV+1]; for (a_int k = 0; k < nbEV+1; k++) d[k] = complex(0., 0.); + complex * workev = new complex[2*nbCV]; + + complex sigma = complex(sigmaReal, sigmaImag); + zneupd_c(rvec, howmny, select, reinterpret_cast<_Complex double*>(d), reinterpret_cast<_Complex double*>(z), ldz, + reinterpret_cast<_Complex double &>(sigma), reinterpret_cast<_Complex double*>(workev), + bMat, nbDim, which, nbEV, tol, reinterpret_cast<_Complex double*>(resid), nbCV, + reinterpret_cast<_Complex double*>(v), ldv, iparam, ipntr, + reinterpret_cast<_Complex double*>(workd), reinterpret_cast<_Complex double*>(workl), lworkl, rwork, &info); + if (info == -14) cerr << "Error: zneupd - KO: dsaupd did not find any eigenvalues to sufficient accuracy" << endl; + if (info < 0 && info != -14 /*-14: don't break*/) {cerr << "Error: zneupd - KO with info " << info << endl; return 1;} + + spectrum(d, z, nbDim, iparam); + + if (workev) {delete [] workev; workev = nullptr;} + if (d) {delete [] d; d = nullptr;} + + return 0; + }; + + int setMode(int const mode, EM const & A, EM const * B, SLV & solver) { + int rc = 1; + + if (mode == 1) { + rc = 0; + } + else if (mode == 2 || mode == 3) { + if (!stdPb && !B) {cerr << "Error: generalized problem without B" << endl; return 1;} + + if (mode == 2) { // Invert mode. + solver.compute(*B); + } + else { // Shift invert mode. + RC sigma; makeSigma(sigma); + auto S = A - sigma*(*B); + solver.compute(S); + } + + rc = 0; + } + else {cerr << "Error: arpack mode must be 1, 2 or 3 - KO" << endl; rc = 1;} + + return rc; + }; + + void restartSolve(string const & fileName, + a_int const & nbDim, RC * rv, bool readNbCV) { + if (restartFromFile) { + ifstream ifs(fileName.c_str()); + if (ifs.is_open()) { + a_int nbCV = 1; if (readNbCV) {ifs >> nbCV; if (nbCV < nbCV) nbCV = nbCV;} + for (a_int n = 0; rv && n < nbDim*nbCV; n++) ifs >> rv[n]; + if (verbose >= 1) { + cout << endl << "arpackSolver:" << endl; + cout << endl << fileName << ": restart OK" << endl; + if (verbose >= 2) { + for (a_int n = 0; rv && n < nbDim; n++) cout << rv[n] << endl; + } + } + } + } + }; + + int initPointerSize(a_int & iparamSz, a_int & ipntrSz, string const & aeupd) { + iparamSz = 11; ipntrSz = 14; + if (aeupd == "aupd") { + if (is_same::value && symPb) ipntrSz = 11; + if (is_same::value && symPb) ipntrSz = 11; + return 0; + } + if (aeupd == "eupd") { + if (is_same::value && symPb) {iparamSz = 7; ipntrSz = 11;} + if (is_same::value && symPb) {iparamSz = 7; ipntrSz = 11;} + return 0; + } + return 1; + }; + + int solve(EM const & A, EM const * B, SLV & solver) { + if (!stdPb && !B) {cerr << "Error: generalized problem without B" << endl; return 1;} + + // Arpack set up. + + // Note: some in/out parameters passed to d[sn][ae]upd are set to 0. before use. + // d[sn][ae]upd uses dgetv0 to generate a random starting vector (when info is initialized to 0). + // dgetv0 rely on resid/v: resid/v should be initialized to 0.0 to avoid "bad" starting random vectors. + + char const * which = mag.c_str(); + a_int ido = 0; // First call to arpack. + char const * iMat = "I"; + char const * gMat = "G"; + char const * bMat = (mode == 1) ? iMat : gMat; + a_int nbDim = A.rows(); + RC zero; makeZero(zero); + if (!resid) { + resid = new RC[nbDim]; + for (a_int n = 0; n < nbDim; n++) resid[n] = zero; // Avoid "bad" starting vector. + }; + restartSolve("arpackSolver.resid.out", nbDim, resid, false); + a_int ldv = nbDim; + if (!v) { + v = new RC[ldv*nbCV]; + for (a_int n = 0; n < ldv*nbCV; n++) v[n] = zero; // Avoid "bad" starting vector. + }; + restartSolve("arpackSolver.v.out", ldv, v, true); + a_int iparamSz = 0, ipntrSz = 0; + int rc = initPointerSize(iparamSz, ipntrSz, "aupd"); + if (rc != 0) {cerr << "Error: bad iparam/ipntr initialization for aupd" << endl; return rc;} + vector iparamAupd(iparamSz, 0); + iparamAupd[0] = 1; // Use exact shifts (=> we'll never have ido == 3). + iparamAupd[2] = maxIt; // Maximum number of iterations. + iparamAupd[3] = 1; // Block size. + iparamAupd[4] = 0; // Number of ev found by arpack. + iparamAupd[6] = mode; + vector ipntrAupd(ipntrSz, 0); + RC * workd = new RC[3*nbDim]; for (a_int n = 0; n < 3*nbDim; n++) workd[n] = zero; // Avoid "bad" X/Y vector. + a_int lworkl = symPb ? nbCV*nbCV + 8*nbCV : 3*nbCV*nbCV + 6*nbCV; + RC * workl = new RC[lworkl]; + a_int info = 0; // Use random initial residual vector. + if (restartFromFile) info = 1; + + // Initialize solver. + + auto start = chrono::high_resolution_clock::now(); + rc = setMode(mode, A, B, solver); + if (rc != 0) {cerr << "Error: bad arpack mode" << endl; return rc;} + auto stop = chrono::high_resolution_clock::now(); + imsTime = chrono::duration_cast(stop - start).count()/1000.; + + // Arpack solve. + + FD * rwork = nullptr; + do { + // Call arpack. + + aupd(&ido, bMat, nbDim, which, resid, v, ldv, iparamAupd.data(), ipntrAupd.data(), workd, workl, lworkl, rwork, &info); + if (info == 1) cerr << "Error: [dz][sn]aupd - KO: maximum number of iterations taken. Increase --maxIt..." << endl; + if (info == 3) cerr << "Error: [dz][sn]aupd - KO: no shifts could be applied. Increase --nbCV..." << endl; + if (info == -9) cerr << "Error: [dz][sn]aupd - KO: starting vector is zero. Retry: play with shift..." << endl; + if (info < 0) {cerr << "Error: [dz][sn]aupd - KO with info " << info << ", nbIt " << iparamAupd[2] << endl; return 1;} + + // Reverse Communication Interface: perform actions according to arpack. + + start = chrono::high_resolution_clock::now(); + + a_int xIdx = ipntrAupd[0] - 1; // 0-based (Fortran is 1-based). + a_int yIdx = ipntrAupd[1] - 1; // 0-based (Fortran is 1-based). + + EV X(workd + xIdx, nbDim); // Arpack provides X. + EV Y(workd + yIdx, nbDim); // Arpack provides Y. + + if (ido == -1) { + if (iparamAupd[6] == 1) { + Y = A * X; + } + else if (iparamAupd[6] == 2) { + Y = A * X; + auto YY = Y; // Use copy of Y (not Y) for solve (avoid potential memory overwrite as Y is both in/out). + Y = solver.solve(YY); // Y = B^-1 * A * X. + } + else if (iparamAupd[6] == 3) { + auto Z = (*B) * X; // Z = B * X. + Y = solver.solve(Z); // Y = (A - sigma * B)^-1 * B * X. + } + } + else if (ido == 1) { + if (iparamAupd[6] == 1) { + Y = A * X; + } + else if (iparamAupd[6] == 2) { + Y = A * X; + if (symPb) X = Y; // Remark 5 in dsaupd documentation. + auto YY = Y; // Use copy of Y (not Y) for solve (avoid potential memory overwrite as Y is both in/out). + Y = solver.solve(YY); // Y = B^-1 * A * X. + } + else if (iparamAupd[6] == 3) { + a_int zIdx = ipntrAupd[2] - 1; // 0-based (Fortran is 1-based). + EV Z(workd + zIdx, nbDim); // Arpack provides Z. + Y = solver.solve(Z); // Y = (A - sigma * B)^-1 * B * X. + } + } + else if (ido == 2) { + if (iparamAupd[6] == 1) Y = X; // Y = I * X. + else if (iparamAupd[6] == 2) Y = (*B) * X; // Y = B * X. + else if (iparamAupd[6] == 3) Y = (*B) * X; // Y = B * X. + } + else if (ido != 99) {cerr << "Error: unexpected ido " << ido << " - KO" << endl; return 1;} + + stop = chrono::high_resolution_clock::now(); + rciTime += chrono::duration_cast(stop - start).count()/1000.; + + } while (ido != 99); + + // Get arpack results (computed eigen values and vectors). + + nbIt = iparamAupd[2]; // Actual number of iterations. + a_int rvec = 1; + char const * howmnyA = "A"; // Ritz vectors. + char const * howmnyP = "P"; // Schur vectors. + char const * howmny = schur ? howmnyP : howmnyA; + a_int * select = new a_int[nbCV]; for (a_int n = 0; n < nbCV; n++) select[n] = 1; + a_int const nbZ = nbDim*(nbEV+1); // Caution: nbEV+1 for dneupd. + RC * z = new RC[nbZ]; for (a_int n = 0; n < nbZ; n++) z[n] = zero; + a_int ldz = nbDim; + rc = initPointerSize(iparamSz, ipntrSz, "eupd"); + if (rc != 0) {cerr << "Error: bad iparam/ipntr initialization for eupd" << endl; return rc;} + vector iparamEupd(iparamSz, 0); + for (a_int p = 0; p < iparamSz; p++) iparamEupd[p] = iparamAupd[p]; // Initialize eupd parameters with aupd ones. + vector ipntrEupd(ipntrSz, 0); + for (a_int p = 0; p < ipntrSz; p++) ipntrEupd[p] = ipntrAupd[p]; // Initialize eupd parameters with aupd ones. + rc = eupd(rvec, howmny, select, z, ldz, bMat, nbDim, which, resid, v, ldv, iparamEupd.data(), ipntrEupd.data(), workd, workl, lworkl, rwork, info); + if (rc != 0) {cerr << "Error: bad arpack eupd" << endl; return rc;} + + if (dumpToFile) { + ofstream rfs("arpackSolver.resid.out"); for (a_int n = 0; n < nbDim; n++) rfs << resid[n] << endl; + ofstream vfs("arpackSolver.v.out"); vfs << nbCV << endl; for (a_int n = 0; n < ldv*nbCV; n++) vfs << v[n] << endl; + } + + // Clean. + + if (rwork) {delete [] rwork; rwork = nullptr;} + if (z) {delete [] z; z = nullptr;} + if (select) {delete [] select; select = nullptr;} + if (workl) {delete [] workl; workl = nullptr;} + if (workd) {delete [] workd; workd = nullptr;} + + return 0; + }; + + void makeSigma( float & sigma) {sigma = (float) sigmaReal;}; + + void makeSigma( double & sigma) {sigma = sigmaReal;}; + + void makeSigma(complex< float> & sigma) {sigma = complex< float>((float) sigmaReal, (float) sigmaImag);}; + + void makeSigma(complex & sigma) {sigma = complex(sigmaReal, sigmaImag);}; + + virtual int initSolver(SLV & solver) = 0; + + virtual void dumpAllParameters() = 0; + + // Public members. + + public: + + // Arpack parameters. + + bool symPb; // Symmetric problem. + a_int nbEV; + a_int nbCV; + double tol; + double sigmaReal, sigmaImag; // Eigen value translation: look for lambda+sigma instead of lambda. + bool dumpToFile; // Dump resid and v to arpackSolver.*.out files after solve. + bool restartFromFile; // Restart solve with resid and v values provided in arpackSolver.*.out files. + string mag; // Magnitude <=> "which" arpack parameter. + int maxIt; + bool schur; + int verbose; + + // Arpack outputs. + + bool stdPb; // Standard or generalized (= not standard). + StdVecZ val; // Eigen values. + StdVecEVZ vec; // Eigen vectors. + int mode; + int nbIt; + double imsTime; // Init mode solver time. + double rciTime; // Reverse communication interface time. + + // Protected members. + + protected: + + a_int nbDim; + + // Private members. + + private: + + RC * resid; // Saved: enable restart from previous solve. + RC * v; // Saved: enable restart from previous solve. +}; + +// Definition of arpackItrSolver class: specialization of arpackSolver using iterative solvers. +// Note: Eigen provides iterative solvers only for sparse matrices. + +// RC: Real or Complex. +// FD: Float or Double. +// EM: Eigen Matrix (sparse only, not dense). +// SLV: Solver. +template +class arpackItrSolver: public arpackSolver { + // Public methods. + + public: + + arpackItrSolver(): arpackSolver() { + slvTol = 1.e-6; + slvMaxIt = 100; + slvILUDropTol = 1.; + slvILUFillFactor = 2; + }; + + void dumpAllParameters() { + this->dumpParameters(); + if (this->verbose >= 1) { + cout << endl << "arpackItrSolver:" << endl; + cout << endl << "slvTol: " << slvTol << endl; + cout << endl << "slvMaxIt: " << slvMaxIt << endl; + cout << endl << "slvILUDropTol: " << slvILUDropTol << endl; + cout << endl << "slvILUFillFactor: " << slvILUFillFactor << endl; + } + }; + + virtual int initSolver(Eigen::BiCGSTAB & solver) { + // Solve with arpack using sparse matrices and iterative solvers. + + solver.setTolerance(slvTol); + solver.setMaxIterations(slvMaxIt); + + return 0; + }; + + virtual int initSolver(Eigen::ConjugateGradient & solver) { + // Solve with arpack using sparse matrices and iterative solvers. + + solver.setTolerance(slvTol); + solver.setMaxIterations(slvMaxIt); + + return 0; + }; + + virtual int initSolver(Eigen::BiCGSTAB> & solver) { + // Solve with arpack using sparse matrices and iterative solvers. + + solver.setTolerance(slvTol); + solver.setMaxIterations(slvMaxIt); + solver.preconditioner().setDroptol(slvILUDropTol); + solver.preconditioner().setFillfactor(slvILUFillFactor); + + return 0; + }; + + virtual int initSolver(Eigen::ConjugateGradient> & solver) { + // Solve with arpack using sparse matrices and iterative solvers. + + solver.setTolerance(slvTol); + solver.setMaxIterations(slvMaxIt); + solver.preconditioner().setDroptol(slvILUDropTol); + solver.preconditioner().setFillfactor(slvILUFillFactor); + + return 0; + }; + + // Public members. + + public: + + // Iterative solvers parameters. + + double slvTol; // Tolerance of the iterative mode solver. + int slvMaxIt; // Maximum number of iterations of the iterative mode solver. + double slvILUDropTol; // Drop tolerance of the ILU preconditioner (if any) of the iterative mode solver. + int slvILUFillFactor; // Fill factor of the ILU preconditioner (if any) of the iterative mode solver. +}; + +// Definition of arpackDrtSolver class: specialization of arpackSolver using direct solvers. +// Note: Eigen provides direct solvers for both sparse and dense matrices. + +// RC: Real or Complex. +// FD: Float or Double. +// EM: Eigen Matrix (sparse or dense). +// SLV: Solver. +template +class arpackDrtSolver: public arpackSolver { + // Public methods. + + public: + + arpackDrtSolver(): arpackSolver() { + slvPvtThd = 1.e-6; + slvOffset = 0.; + slvScale = 1.; + }; + + void dumpAllParameters() { + this->dumpParameters(); + if (this->verbose >= 1) { + cout << endl << "arpackDrtSolver:" << endl; + cout << endl << "slvPvtThd: " << slvPvtThd << endl; + cout << endl << "slvOffset: " << slvOffset << endl; + cout << endl << "slvScale: " << slvScale << endl; + } + }; + + virtual int initSolver(Eigen::SparseLU> & solver) { + // Solve with arpack using sparse matrices and direct solvers. + + solver.setPivotThreshold(slvPvtThd); + + return 0; + }; + + virtual int initSolver(Eigen::SparseQR> & solver) { + // Solve with arpack using sparse matrices and direct solvers. + + solver.setPivotThreshold(slvPvtThd); + + return 0; + }; + + virtual int initSolver(Eigen::SimplicialLLT> & solver) { + // Solve with arpack using sparse matrices and direct solvers. + + solver.setShift(slvOffset, slvScale); + + return 0; + }; + + virtual int initSolver(Eigen::SimplicialLDLT> & solver) { + // Solve with arpack using sparse matrices and direct solvers. + + solver.setShift(slvOffset, slvScale); + + return 0; + }; + + virtual int initSolver(Eigen::LLT & solver) { + // Solve with arpack using dense matrices and direct solvers. + + if (this->mode == 1) return 0; + + solver = Eigen::LLT(this->nbDim); + + return 0; + }; + + virtual int initSolver(Eigen::LDLT & solver) { + // Solve with arpack using dense matrices and direct solvers. + + if (this->mode == 1) return 0; + + solver = Eigen::LDLT(this->nbDim); + + return 0; + }; + + virtual int initSolver(Eigen::FullPivLU & solver) { + // Solve with arpack using dense matrices and direct solvers. + + if (this->mode == 1) return 0; + + solver = Eigen::FullPivLU(this->nbDim, this->nbDim); + solver.setThreshold(slvPvtThd); + + return 0; + }; + + virtual int initSolver(Eigen::FullPivHouseholderQR & solver) { + // Solve with arpack using dense matrices and direct solvers. + + if (this->mode == 1) return 0; + + solver = Eigen::FullPivHouseholderQR(this->nbDim, this->nbDim); + solver.setThreshold(slvPvtThd); + + return 0; + }; + + virtual int initSolver(Eigen::PartialPivLU & solver) { + // Solve with arpack using dense matrices and direct solvers. + + if (this->mode == 1) return 0; + + solver = Eigen::PartialPivLU(this->nbDim); + + return 0; + }; + + virtual int initSolver(Eigen::HouseholderQR & solver) { + // Solve with arpack using dense matrices and direct solvers. + + if (this->mode == 1) return 0; + + solver = Eigen::HouseholderQR(this->nbDim, this->nbDim); + + return 0; + }; + + // Public members. + + public: + + // Direct solvers parameters. + + double slvPvtThd; // Pivoting tolerance of the direct mode solver. + double slvOffset; // Cholesky offset (LLT, LDLT) of the direct mode solver. + double slvScale; // Cholesky scale (LLT, LDLT) of the direct mode solver. +}; + +#endif + +// Local Variables: +// mode: c++ +// c-file-style:"stroustrup" +// show-trailing-whitespace: t +// End: +/* vim: set sw=2 ts=2 et smartindent :*/ diff -Nru arpack-3.7.0/EXAMPLES/MATRIX_MARKET/arpackSolver.pc.in arpack-3.8.0/EXAMPLES/MATRIX_MARKET/arpackSolver.pc.in --- arpack-3.7.0/EXAMPLES/MATRIX_MARKET/arpackSolver.pc.in 1970-01-01 00:00:00.000000000 +0000 +++ arpack-3.8.0/EXAMPLES/MATRIX_MARKET/arpackSolver.pc.in 2020-12-07 10:40:45.000000000 +0000 @@ -0,0 +1,10 @@ +prefix=@prefix@ +exec_prefix=@exec_prefix@ +includedir=@includedir@ + +Name: arpackSolver +Description: Utility to test arpack with matrix market files +Version: @PACKAGE_VERSION@ +URL: @PACKAGE_URL@ +Requires: arpack, eigen3 >= 3.3 +Cflags: -I${includedir}/arpack diff -Nru arpack-3.7.0/EXAMPLES/MATRIX_MARKET/Makefile.am arpack-3.8.0/EXAMPLES/MATRIX_MARKET/Makefile.am --- arpack-3.7.0/EXAMPLES/MATRIX_MARKET/Makefile.am 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/EXAMPLES/MATRIX_MARKET/Makefile.am 2020-12-07 10:40:45.000000000 +0000 @@ -1,6 +1,8 @@ LDADD = $(top_builddir)/SRC/libarpack$(LIBSUFFIX).la AM_CPPFLAGS = -I$(top_builddir) -I$(top_srcdir)/ICB $(EIGEN3_CFLAGS) +pkgincludedir = $(includedir)/arpack + EXTRA_DIST = README check_PROGRAMS = arpackmm @@ -10,4 +12,14 @@ arpackmm_SOURCES = arpackmm.cpp -CLEANFILES = resid.out v.out +if ICBEXMM +pkginclude_HEADERS = arpackSolver.hpp +pkgconfig_DATA = arpackSolver.pc +endif + +CLEANFILES = \ + arpackmm.run.log \ + arpackmm.resid.out \ + arpackmm.v.out \ + arpackSolver.resid.out \ + arpackSolver.v.out diff -Nru arpack-3.7.0/EXAMPLES/MATRIX_MARKET/README arpack-3.8.0/EXAMPLES/MATRIX_MARKET/README --- arpack-3.7.0/EXAMPLES/MATRIX_MARKET/README 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/EXAMPLES/MATRIX_MARKET/README 2020-12-07 10:40:45.000000000 +0000 @@ -9,8 +9,25 @@ To compute small eigen values, it may be a better choice to look for large eigen values with invert or shift+invert. -If solve breaks down, you may increase --nbCV, try --restart, -play with --shiftReal/Imag and/or --invert. +How to use this utility ? +Start simple, then, increase complexity if/when needed: +- defaults to: standard real symmetric eigen problem to be + solved accurately (double precision). +- list all possible options with --help. +- add --verbose or --debug to get more informations. +- if solve breaks down, you may: + - play with --nbCV (increase workspace size). + - play with --shiftReal/Imag and/or --invert. + - if arpack mode > 1, change solver with --slv. + - if arpack mode > 1, change solver parameters with --slv + (typically: pivoting threshold, solver tolerance, ...). + - try --restart (restart from previous eigen basis + approximation computed by previous run). + - etc... + +Note: using openblas/mkl/atlas instead of netlib blas/lapack +may impact results. In some cases, it may also fail checks. +Use --noCheck to skip checks. To build this utility, you need: - to use a fortran compiler which supports iso_c_binding. diff -Nru arpack-3.7.0/EXAMPLES/PYARPACK/pyarpack.cpp arpack-3.8.0/EXAMPLES/PYARPACK/pyarpack.cpp --- arpack-3.7.0/EXAMPLES/PYARPACK/pyarpack.cpp 1970-01-01 00:00:00.000000000 +0000 +++ arpack-3.8.0/EXAMPLES/PYARPACK/pyarpack.cpp 2020-12-07 10:40:45.000000000 +0000 @@ -0,0 +1,431 @@ +#include // PyErr_SetString. + +#include +#include +#include +#include +#include +#include +#include // ostringstream. +#include +#include + +namespace bp = boost::python; +namespace bn = boost::python::numpy; + +template +void exportArpackSparseItr(bp::scope& pySlv, std::string const& dtype) { + // Created nested namespace in module. + + pySlv.attr(dtype.c_str()) = + bp::class_>( + dtype.c_str(), + "arpack data type (must be consistent with numpy dtype)") + .def("solve", &pyarpackSparseItrSolver::solve, + (bp::arg("A"), bp::arg("B") = bp::tuple()), + "solve standard or generalised eigen problem where A and B must " + "be sparse and provided in coo format: (dimension, row-indice " + "array, column-indice array, matrice-value array) tuple") + .def("checkEigVec", + &pyarpackSparseItrSolver::checkEigVec, + (bp::arg("A"), bp::arg("B") = bp::tuple(), + bp::arg("diffTol") = 1.e-3), + "check eigen vectors accuracy where A and B must be sparse and " + "provided in coo format: (dimension, row-indice array, " + "column-indice array, matrice-value array) tuple") + ARPACKSOLVERMEMBER(pyarpackSparseItrSolver) + .def_readwrite( + "slvTol", &pyarpackSparseItrSolver::slvTol, + "tolerance of the iterative mode solver - default: 1.e-6") + .def_readwrite("slvMaxIt", + &pyarpackSparseItrSolver::slvMaxIt, + "maximum number of iterations of the iterative mode " + "solver - default: 100") + .def_readwrite( + "slvILUDropTol", + &pyarpackSparseItrSolver::slvILUDropTol, + "drop tolerance of the ILU preconditioner (if any) of the " + "iterative mode solver - default: 1") + .def_readwrite( + "slvILUFillFactor", + &pyarpackSparseItrSolver::slvILUFillFactor, + "fill factor of the ILU preconditioner (if any) of the iterative " + "mode solver - default: 2"); +}; + +template +void exportArpackSparseDrt(bp::scope& pySlv, std::string const& dtype) { + // Created nested namespace in module. + + pySlv.attr(dtype.c_str()) = + bp::class_>( + dtype.c_str(), + "arpack data type (must be consistent with numpy dtype)") + .def("solve", &pyarpackSparseDrtSolver::solve, + (bp::arg("A"), bp::arg("B") = bp::tuple()), + "solve standard or generalised eigen problem where A and B must " + "be sparse and provided in coo format: (dimension, row-indice " + "array, column-indice array, matrice-value array) tuple") + .def("checkEigVec", + &pyarpackSparseDrtSolver::checkEigVec, + (bp::arg("A"), bp::arg("B") = bp::tuple(), + bp::arg("diffTol") = 1.e-3), + "check eigen vectors accuracy where A and B must be sparse and " + "provided in coo format: (dimension, row-indice array, " + "column-indice array, matrice-value array) tuple") + ARPACKSOLVERMEMBER(pyarpackSparseDrtSolver) + .def_readwrite( + "slvPvtThd", &pyarpackSparseDrtSolver::slvPvtThd, + "pivoting tolerance of the direct mode solver - default: 1.e-6") + .def_readwrite("slvOffset", + &pyarpackSparseDrtSolver::slvOffset, + "cholesky offset (LLT, LDLT) of the direct mode " + "solver - default: 0.") + .def_readwrite("slvScale", + &pyarpackSparseDrtSolver::slvScale, + "cholesky scale (LLT, LDLT) of the direct mode solver " + "- default: 1."); +}; + +template +void exportArpackDenseDrt(bp::scope& pySlv, std::string const& dtype) { + // Created nested namespace in module. + + pySlv.attr(dtype.c_str()) = + bp::class_>( + dtype.c_str(), + "arpack data type (must be consistent with numpy dtype)") + .def("solve", &pyarpackDenseDrtSolver::solve, + (bp::arg("A"), bp::arg("B") = bp::tuple()), + "solve standard or generalised eigen problem where A and B must " + "be dense and provided in raw format: (n-squared matrice-value " + "array, row or column ordered boolean)") + .def("checkEigVec", + &pyarpackDenseDrtSolver::checkEigVec, + (bp::arg("A"), bp::arg("B") = bp::tuple(), + bp::arg("diffTol") = 1.e-3), + "check eigen vectors accuracy where A and B must be dense and " + "provided in raw format: (n-squared matrice-value array, row or " + "column ordered boolean)") + ARPACKSOLVERMEMBER(pyarpackDenseDrtSolver) + .def_readwrite( + "slvPvtThd", &pyarpackDenseDrtSolver::slvPvtThd, + "pivoting tolerance of the direct mode solver - default: 1.e-6") + .def_readwrite("slvOffset", + &pyarpackDenseDrtSolver::slvOffset, + "cholesky offset (LLT, LDLT) of the direct mode " + "solver - default: 0.") + .def_readwrite("slvScale", + &pyarpackDenseDrtSolver::slvScale, + "cholesky scale (LLT, LDLT) of the direct mode solver " + "- default: 1."); +}; + +class sparseBiCGDiag {}; +class sparseBiCGILU {}; +class sparseCGDiag {}; +class sparseCGILU {}; +class sparseLLT {}; +class sparseLDLT {}; +class sparseLU {}; +class sparseQR {}; + +class denseLLT {}; +class denseLDLT {}; +class denseLURR {}; +class denseQRRR {}; +class denseLUPP {}; +class denseQRPP {}; + +std::complex EigVecZGetItem( + Eigen::Matrix, Eigen::Dynamic, 1>& M, int idx) { + if (idx < 0 || idx >= M.size()) { + pyarpackThrowError("index out of range"); + return std::complex(); + } + return M[idx]; +}; + +std::string EigVecZToString(EigVecZ const& vec) { + std::ostringstream s; + s << vec; + return s.str(); +}; + +BOOST_PYTHON_MODULE(pyarpack) { + // Initialize. + + bn::initialize(); + + bp::class_>>("StdVecZ").def( + bp::vector_indexing_suite>>()); + + bp::class_, Eigen::Dynamic, 1>>("EigVecZ") + .def("__getitem__", &EigVecZGetItem) + .def("__str__", &EigVecZToString); + + bp::class_>("StdVecEVZ") + .def("__iter__", bp::iterator>()) + .def(bp::vector_indexing_suite>()); + + // Documentation of the python module. + + std::ostringstream doc; + doc << "You can use sparse or dense matrices, and, play with iterative or direct mode solvers (CG, LU, ...):" << std::endl; + doc << "1. choose arpack solver with a given mode solver" << std::endl; + doc << " 1.1. if you need to handle sparse matrices" << std::endl; + doc << " >> from pyarpack import sparseBiCG as pyarpackSlv" << std::endl; + doc << " 1.2. if you need to handle dense matrices" << std::endl; + doc << " >> from pyarpack import denseBiCG as pyarpackSlv" << std::endl; + doc << "2. choose arpack data type (float, double, ...)" << std::endl; + doc << " >> arpackSlv = pyarpackSlv.double()" << std::endl; + doc << "3. solve the eigen problem" << std::endl; + doc << " >> arpackSlv.solve(A, B)" << std::endl; + doc << "4. get eigen values and vectors" << std::endl; + doc << " >> print(arpackSlv.vec)" << std::endl; + doc << " >> print(arpackSlv.val)" << std::endl; + doc << std::endl; + doc << "Notes:" << std::endl; + doc << "1. arpack data type (float, double, ...) must be consistent with A/B numpy dtypes (float32, float64, ...)." << std::endl; + doc << " at python side, the data MUST be casted in the EXACT expected type (int32, int64, float, double, ...)." << std::endl; + doc << " otherwise, C++ may not get the data the way it expects them: C++ will not know how to read python data." << std::endl; + doc << " if you are not sure how data have been passed from python to C++, set arpackSlv.debug = 1 and check out debug traces." << std::endl; + doc << " in other words, pyarpack users MUST :" << std::endl; + doc << " 1.1. create numpy arrays specifying explicitly the type:" << std::endl; + doc << " >> Aij = np.array([], dtype='complex128')" << std::endl; + doc << " 1.2. filling numpy arrays casting value on append:" << std::endl; + doc << " >> Aij = np.append(Aij, np.complex128(np.complex( 200., 200.))) # Casting value on append is MANDATORY or C++ won't get the expected type." << std::endl; + doc << " 1.3. calling the solver flavor which is consistent with the numpy array data type:" << std::endl; + doc << " >> arpackSlv = pyarpackSlv.complexDouble() # Caution: complexDouble <=> np.array(..., dtype='complex128')" << std::endl; + doc << " note: NO data type check can be done at C++ side, the pyarpack user MUST insure data consistency." << std::endl; + doc << "2. sparse matrices must be provided in coo format (n, i, j, Mij), that is, as a tuple where:" << std::endl; + doc << " 2.1. n is an integer." << std::endl; + doc << " 2.2. i, j, Mij are 1 x nnz numpy arrays." << std::endl; + doc << "3. dense matrices must be provided in raw format (Mij, rowOrdered), that is, as a tuple where:" << std::endl; + doc << " 3.1. Mij is an n x n numpy array." << std::endl; + doc << " 3.2. rowOrdered is a boolean (column ordered if False)." << std::endl; + doc << "4. arpack mode solver are provided by eigen:" << std::endl; + doc << " 4.1. when solver is iterative, A and B can be sparse only." << std::endl; + doc << " 4.2. when solver is direct, A and B can be sparse or dense." << std::endl; + bp::scope().attr("__doc__") = doc.str().c_str(); + + // Specify that this module is actually a package. + + bp::object package = bp::scope(); + package.attr("__path__") = "pyarpack"; + + // Create python module. + + std::string module = "pyarpack"; + bp::object pyModule( + bp::handle<>(bp::borrowed(PyImport_AddModule(module.c_str())))); + + // Create modules. + + { + std::string slv = "sparseBiCGDiag"; + std::string slvHelp = + "arpack internal mode solver (mode > 1): BiCG with diagonal (Jacobi) " + "preconditioner"; + bp::scope pySlvBiCGDiag = + bp::class_(slv.c_str(), slvHelp.c_str()); + exportArpackSparseItr(pySlvBiCGDiag, + "float"); + exportArpackSparseItr(pySlvBiCGDiag, + "double"); + exportArpackSparseItr, float, EigSMxC, EigSBiCGC>( + pySlvBiCGDiag, "complexFloat"); + exportArpackSparseItr, double, EigSMxZ, EigSBiCGZ>( + pySlvBiCGDiag, "complexDouble"); + } + + { + std::string slv = "sparseBiCGILU"; + std::string slvHelp = + "arpack internal mode solver (mode > 1): BiCG with ILU preconditioner"; + bp::scope pySlvBiCGILU = + bp::class_(slv.c_str(), slvHelp.c_str()); + exportArpackSparseItr(pySlvBiCGILU, + "float"); + exportArpackSparseItr(pySlvBiCGILU, + "double"); + exportArpackSparseItr, float, EigSMxC, EigSBiCGILUC>( + pySlvBiCGILU, "complexFloat"); + exportArpackSparseItr, double, EigSMxZ, EigSBiCGILUZ>( + pySlvBiCGILU, "complexDouble"); + } + + { + std::string slv = "sparseCGDiag"; + std::string slvHelp = + "arpack internal mode solver (mode > 1): CG with diagonal (Jacobi) " + "preconditioner"; + bp::scope pySlvCGDiag = + bp::class_(slv.c_str(), slvHelp.c_str()); + exportArpackSparseItr(pySlvCGDiag, "float"); + exportArpackSparseItr(pySlvCGDiag, + "double"); + exportArpackSparseItr, float, EigSMxC, EigSCGC>( + pySlvCGDiag, "complexFloat"); + exportArpackSparseItr, double, EigSMxZ, EigSCGZ>( + pySlvCGDiag, "complexDouble"); + } + + { + std::string slv = "sparseCGILU"; + std::string slvHelp = + "arpack internal mode solver (mode > 1): CG with ILU preconditioner"; + bp::scope pySlvCGILU = + bp::class_(slv.c_str(), slvHelp.c_str()); + exportArpackSparseItr(pySlvCGILU, + "float"); + exportArpackSparseItr(pySlvCGILU, + "double"); + exportArpackSparseItr, float, EigSMxC, EigSCGILUC>( + pySlvCGILU, "complexFloat"); + exportArpackSparseItr, double, EigSMxZ, EigSCGILUZ>( + pySlvCGILU, "complexDouble"); + } + + { + std::string slv = "sparseLLT"; + std::string slvHelp = "arpack internal mode solver (mode > 1): LLT"; + bp::scope pySlvLLT = bp::class_(slv.c_str(), slvHelp.c_str()); + exportArpackSparseDrt(pySlvLLT, "float"); + exportArpackSparseDrt(pySlvLLT, + "double"); + exportArpackSparseDrt, float, EigSMxC, EigSLLTC>( + pySlvLLT, "complexFloat"); + exportArpackSparseDrt, double, EigSMxZ, EigSLLTZ>( + pySlvLLT, "complexDouble"); + } + + { + std::string slv = "sparseLDLT"; + std::string slvHelp = "arpack internal mode solver (mode > 1): LDLT"; + bp::scope pySlvLDLT = bp::class_(slv.c_str(), slvHelp.c_str()); + exportArpackSparseDrt(pySlvLDLT, "float"); + exportArpackSparseDrt(pySlvLDLT, + "double"); + exportArpackSparseDrt, float, EigSMxC, EigSLDLTC>( + pySlvLDLT, "complexFloat"); + exportArpackSparseDrt, double, EigSMxZ, EigSLDLTZ>( + pySlvLDLT, "complexDouble"); + } + + { + std::string slv = "sparseLU"; + std::string slvHelp = "arpack internal mode solver (mode > 1): LU"; + bp::scope pySlvLU = bp::class_(slv.c_str(), slvHelp.c_str()); + exportArpackSparseDrt(pySlvLU, "float"); + exportArpackSparseDrt(pySlvLU, "double"); + exportArpackSparseDrt, float, EigSMxC, EigSLUC>( + pySlvLU, "complexFloat"); + exportArpackSparseDrt, double, EigSMxZ, EigSLUZ>( + pySlvLU, "complexDouble"); + } + + { + std::string slv = "sparseQR"; + std::string slvHelp = "arpack internal mode solver (mode > 1): QR"; + bp::scope pySlvQR = bp::class_(slv.c_str(), slvHelp.c_str()); + exportArpackSparseDrt(pySlvQR, "float"); + exportArpackSparseDrt(pySlvQR, "double"); + exportArpackSparseDrt, float, EigSMxC, EigSQRC>( + pySlvQR, "complexFloat"); + exportArpackSparseDrt, double, EigSMxZ, EigSQRZ>( + pySlvQR, "complexDouble"); + } + + { + std::string slv = "denseLLT"; + std::string slvHelp = "arpack internal mode solver (mode > 1): LLT"; + bp::scope pySlvLLT = bp::class_(slv.c_str(), slvHelp.c_str()); + exportArpackDenseDrt(pySlvLLT, "float"); + exportArpackDenseDrt(pySlvLLT, "double"); + exportArpackDenseDrt, float, EigDMxC, EigDLLTC>( + pySlvLLT, "complexFloat"); + exportArpackDenseDrt, double, EigDMxZ, EigDLLTZ>( + pySlvLLT, "complexDouble"); + } + + { + std::string slv = "denseLDLT"; + std::string slvHelp = "arpack internal mode solver (mode > 1): LDLT"; + bp::scope pySlvLDLT = bp::class_(slv.c_str(), slvHelp.c_str()); + exportArpackDenseDrt(pySlvLDLT, "float"); + exportArpackDenseDrt(pySlvLDLT, + "double"); + exportArpackDenseDrt, float, EigDMxC, EigDLDLTC>( + pySlvLDLT, "complexFloat"); + exportArpackDenseDrt, double, EigDMxZ, EigDLDLTZ>( + pySlvLDLT, "complexDouble"); + } + + { + std::string slv = "denseLURR"; + std::string slvHelp = + "arpack internal mode solver (mode > 1): LU Rank Revealing (slower, " + "more stable)"; + bp::scope pySlvLURR = bp::class_(slv.c_str(), slvHelp.c_str()); + exportArpackDenseDrt(pySlvLURR, "float"); + exportArpackDenseDrt(pySlvLURR, + "double"); + exportArpackDenseDrt, float, EigDMxC, EigDFLUC>( + pySlvLURR, "complexFloat"); + exportArpackDenseDrt, double, EigDMxZ, EigDFLUZ>( + pySlvLURR, "complexDouble"); + } + + { + std::string slv = "denseQRRR"; + std::string slvHelp = + "arpack internal mode solver (mode > 1): QR Rank Revealing (slower, " + "more stable)"; + bp::scope pySlvQRRR = bp::class_(slv.c_str(), slvHelp.c_str()); + exportArpackDenseDrt(pySlvQRRR, "float"); + exportArpackDenseDrt(pySlvQRRR, + "double"); + exportArpackDenseDrt, float, EigDMxC, EigDFQRC>( + pySlvQRRR, "complexFloat"); + exportArpackDenseDrt, double, EigDMxZ, EigDFQRZ>( + pySlvQRRR, "complexDouble"); + } + + { + std::string slv = "denseLUPP"; + std::string slvHelp = + "arpack internal mode solver (mode > 1): LU Partial Pivoting (faster, " + "less stable)"; + bp::scope pySlvLUPP = bp::class_(slv.c_str(), slvHelp.c_str()); + exportArpackDenseDrt(pySlvLUPP, "float"); + exportArpackDenseDrt(pySlvLUPP, + "double"); + exportArpackDenseDrt, float, EigDMxC, EigDPLUC>( + pySlvLUPP, "complexFloat"); + exportArpackDenseDrt, double, EigDMxZ, EigDPLUZ>( + pySlvLUPP, "complexDouble"); + } + + { + std::string slv = "denseQRPP"; + std::string slvHelp = + "arpack internal mode solver (mode > 1): QR Partial Pivoting (faster, " + "less stable)"; + bp::scope pySlvQPPR = bp::class_(slv.c_str(), slvHelp.c_str()); + exportArpackDenseDrt(pySlvQPPR, "float"); + exportArpackDenseDrt(pySlvQPPR, + "double"); + exportArpackDenseDrt, float, EigDMxC, EigDPQRC>( + pySlvQPPR, "complexFloat"); + exportArpackDenseDrt, double, EigDMxZ, EigDPQRZ>( + pySlvQPPR, "complexDouble"); + } +} + +// Local Variables: +// mode: c++ +// c-file-style:"stroustrup" +// show-trailing-whitespace: t +// End: +/* vim: set sw=2 ts=2 et smartindent :*/ diff -Nru arpack-3.7.0/EXAMPLES/PYARPACK/pyarpackDenseLDLT.py.in arpack-3.8.0/EXAMPLES/PYARPACK/pyarpackDenseLDLT.py.in --- arpack-3.7.0/EXAMPLES/PYARPACK/pyarpackDenseLDLT.py.in 1970-01-01 00:00:00.000000000 +0000 +++ arpack-3.8.0/EXAMPLES/PYARPACK/pyarpackDenseLDLT.py.in 2020-12-07 10:40:45.000000000 +0000 @@ -0,0 +1,118 @@ +#!/usr/bin/env python + +import numpy as np +from pyarpack import denseLDLT as pyarpackSlv + +# Build laplacian. + +n = 4 +Aij = np.array([], dtype='complex128') +for k in range(n): + for l in range(n): + if l == k: + Aij = np.append(Aij, np.complex128(np.complex( 200., 200.))) # Casting value on append is MANDATORY or C++ won't get the expected type. + elif l == k-1: + Aij = np.append(Aij, np.complex128(np.complex(-101., -101.))) # Casting value on append is MANDATORY or C++ won't get the expected type. + elif l == k+1: + Aij = np.append(Aij, np.complex128(np.complex( -99., -99.))) # Casting value on append is MANDATORY or C++ won't get the expected type. + else: + Aij = np.append(Aij, np.complex128(np.complex( 0., 0.))) # Casting value on append is MANDATORY or C++ won't get the expected type. +for idx, val in enumerate(Aij): + print("A[", idx, "] =", val) +A = (Aij, False) # raw format: Aij values, row ordered (or not). + +# Get and tune arpack solver. + +arpackSlv = pyarpackSlv.complexDouble() # Caution: complexDouble <=> np.array(..., dtype='complex128') +arpackSlv.verbose = 3 # Set to 0 to get a quiet solve. +arpackSlv.debug = 1 # Set to 0 to get a quiet solve. +arpackSlv.nbEV = 1 +arpackSlv.nbCV = 2*arpackSlv.nbEV + 1 +arpackSlv.mag = 'LM' +arpackSlv.maxIt = 200 +arpackSlv.slvOffset = 0. +arpackSlv.slvScale = 1. +arpackSlv.symPb = False + +# Solve eigen problem. + +rc = arpackSlv.solve(A) +assert rc == 0, "bad solve" +rc = arpackSlv.checkEigVec(A) +assert rc == 0, "bad checkEigVec" + +# Print out results (mode selected, eigen vectors, eigen values, ...). + +assert arpackSlv.nbEV == len(arpackSlv.val), "bad result" +print("\nresults:\n") +print("mode selected:", arpackSlv.mode) +print("nb iterations:", arpackSlv.nbIt) +print("Reverse Communication Interface time:", arpackSlv.rciTime, "s") +for val, vec in zip(arpackSlv.val, arpackSlv.vec): + print("eigen value:", val) + print("eigen vector:") + print(vec) + +####################################################################################### +print("\n##########################################################################\n") +####################################################################################### + +# Build laplacian. + +n = 8 +Aij = np.array([], dtype='complex64') +Bij = np.array([], dtype='complex64') +for k in range(n): + for l in range(n): + if l == k: + Aij = np.append(Aij, np.complex64(np.complex( 200., 200.))) # Casting value on append is MANDATORY or C++ won't get the expected type. + Bij = np.append(Bij, np.complex64(np.complex( 33.3, 33.3))) # Casting value on append is MANDATORY or C++ won't get the expected type. + elif l == k-1: + Aij = np.append(Aij, np.complex64(np.complex(-101., -101.))) # Casting value on append is MANDATORY or C++ won't get the expected type. + Bij = np.append(Bij, np.complex64(np.complex( 16.6, 16.6))) # Casting value on append is MANDATORY or C++ won't get the expected type. + elif l == k+1: + Aij = np.append(Aij, np.complex64(np.complex( -99., -99.))) # Casting value on append is MANDATORY or C++ won't get the expected type. + Bij = np.append(Bij, np.complex64(np.complex( 16.6, 16.6))) # Casting value on append is MANDATORY or C++ won't get the expected type. + else: + Aij = np.append(Aij, np.complex64(np.complex( 0., 0.))) # Casting value on append is MANDATORY or C++ won't get the expected type. + Bij = np.append(Bij, np.complex64(np.complex( 0., 0.))) # Casting value on append is MANDATORY or C++ won't get the expected type. +for idx, val in enumerate(Aij): + print("A[", idx, "] =", val) +for idx, val in enumerate(Bij): + print("B[", idx, "] =", val) +A = (Aij, False) # raw format: Aij values, row ordered (or not). +B = (Bij, True) # raw format: Bij values, row ordered (or not). + +# Get and tune arpack solver. + +arpackSlv = pyarpackSlv.complexFloat() # Caution: complexFloat <=> np.array(..., dtype='complex64') +arpackSlv.verbose = 3 # Set to 0 to get a quiet solve. +arpackSlv.debug = 1 # Set to 0 to get a quiet solve. +arpackSlv.nbEV = 2 +arpackSlv.nbCV = 2*arpackSlv.nbEV + 1 +arpackSlv.mag = 'LM' +arpackSlv.maxIt = 200 +arpackSlv.slvOffset = 0. +arpackSlv.slvScale = 1. +arpackSlv.sigmaReal = 1 +arpackSlv.symPb = False + +# Solve eigen problem. + +rc = arpackSlv.solve(A, B) +assert rc == 0, "bad solve" +rc = arpackSlv.checkEigVec(A, B, 1.e-2) +assert rc == 0, "bad checkEigVec" + +# Print out results (mode selected, eigen vectors, eigen values, ...). + +assert arpackSlv.nbEV == len(arpackSlv.val), "bad result" +print("\nresults:\n") +print("mode selected:", arpackSlv.mode) +print("nb iterations:", arpackSlv.nbIt) +print("Reverse Communication Interface time:", arpackSlv.rciTime, "s") +for val, vec in zip(arpackSlv.val, arpackSlv.vec): + print("eigen value:", val) + print("eigen vector:") + for v in range(n): + print(vec[v]) diff -Nru arpack-3.7.0/EXAMPLES/PYARPACK/pyarpackDenseLLT.py.in arpack-3.8.0/EXAMPLES/PYARPACK/pyarpackDenseLLT.py.in --- arpack-3.7.0/EXAMPLES/PYARPACK/pyarpackDenseLLT.py.in 1970-01-01 00:00:00.000000000 +0000 +++ arpack-3.8.0/EXAMPLES/PYARPACK/pyarpackDenseLLT.py.in 2020-12-07 10:40:45.000000000 +0000 @@ -0,0 +1,110 @@ +#!/usr/bin/env python + +import numpy as np +from pyarpack import denseLLT as pyarpackSlv + +# Build laplacian. + +n = 4 +Aij = np.array([], dtype='float64') +for k in range(n): + for l in range(n): + if l == k: + Aij = np.append(Aij, np.float64( 200.)) # Casting value on append is MANDATORY or C++ won't get the expected type. + elif l == k-1 or l == k+1: + Aij = np.append(Aij, np.float64(-100.)) # Casting value on append is MANDATORY or C++ won't get the expected type. + else: + Aij = np.append(Aij, np.float64( 0.)) # Casting value on append is MANDATORY or C++ won't get the expected type. +for idx, val in enumerate(Aij): + print("A[", idx, "] =", val) +A = (Aij, False) # raw format: Aij values, row ordered (or not). + +# Get and tune arpack solver. + +arpackSlv = pyarpackSlv.double() # Caution: double <=> np.array(..., dtype='float64') +arpackSlv.verbose = 3 # Set to 0 to get a quiet solve. +arpackSlv.debug = 1 # Set to 0 to get a quiet solve. +arpackSlv.nbEV = 1 +arpackSlv.nbCV = 2*arpackSlv.nbEV + 1 +arpackSlv.mag = 'LM' +arpackSlv.maxIt = 200 +arpackSlv.slvOffset = 0. +arpackSlv.slvScale = 1. + +# Solve eigen problem. + +rc = arpackSlv.solve(A) +assert rc == 0, "bad solve" +rc = arpackSlv.checkEigVec(A) +assert rc == 0, "bad checkEigVec" + +# Print out results (mode selected, eigen vectors, eigen values, ...). + +assert arpackSlv.nbEV == len(arpackSlv.val), "bad result" +print("\nresults:\n") +print("mode selected:", arpackSlv.mode) +print("nb iterations:", arpackSlv.nbIt) +print("Reverse Communication Interface time:", arpackSlv.rciTime, "s") +for val, vec in zip(arpackSlv.val, arpackSlv.vec): + print("eigen value:", val) + print("eigen vector:") + print(vec) + +####################################################################################### +print("\n##########################################################################\n") +####################################################################################### + +# Build laplacian. + +n = 8 +Aij = np.array([], dtype='float32') +Bij = np.array([], dtype='float32') +for k in range(n): + for l in range(n): + if l == k: + Aij = np.append(Aij, np.float32( 200.)) # Casting value on append is MANDATORY or C++ won't get the expected type. + Bij = np.append(Bij, np.float32( 33.3)) # Casting value on append is MANDATORY or C++ won't get the expected type. + elif l == k-1 or l == k+1: + Aij = np.append(Aij, np.float32(-100.)) # Casting value on append is MANDATORY or C++ won't get the expected type. + Bij = np.append(Bij, np.float32( 16.6)) # Casting value on append is MANDATORY or C++ won't get the expected type. + else: + Aij = np.append(Aij, np.float32( 0.)) # Casting value on append is MANDATORY or C++ won't get the expected type. + Bij = np.append(Bij, np.float32( 0.)) # Casting value on append is MANDATORY or C++ won't get the expected type. +for idx, val in enumerate(Aij): + print("A[", idx, "] =", val) +for idx, val in enumerate(Bij): + print("B[", idx, "] =", val) +A = (Aij, False) # raw format: Aij values, row ordered (or not). +B = (Bij, True) # raw format: Bij values, row ordered (or not). + +# Get and tune arpack solver. + +arpackSlv = pyarpackSlv.float() # Caution: float <=> np.array(..., dtype='float32') +arpackSlv.verbose = 3 # Set to 0 to get a quiet solve. +arpackSlv.debug = 1 # Set to 0 to get a quiet solve. +arpackSlv.nbEV = 2 +arpackSlv.nbCV = 2*arpackSlv.nbEV + 1 +arpackSlv.mag = 'LM' +arpackSlv.maxIt = 200 +arpackSlv.slvOffset = 0. +arpackSlv.slvScale = 1. + +# Solve eigen problem. + +rc = arpackSlv.solve(A, B) +assert rc == 0, "bad solve" +rc = arpackSlv.checkEigVec(A, B, 1.e-2) +assert rc == 0, "bad checkEigVec" + +# Print out results (mode selected, eigen vectors, eigen values, ...). + +assert arpackSlv.nbEV == len(arpackSlv.val), "bad result" +print("\nresults:\n") +print("mode selected:", arpackSlv.mode) +print("nb iterations:", arpackSlv.nbIt) +print("Reverse Communication Interface time:", arpackSlv.rciTime, "s") +for val, vec in zip(arpackSlv.val, arpackSlv.vec): + print("eigen value:", val) + print("eigen vector:") + for v in range(n): + print(vec[v]) diff -Nru arpack-3.7.0/EXAMPLES/PYARPACK/pyarpackDenseLUPP.py.in arpack-3.8.0/EXAMPLES/PYARPACK/pyarpackDenseLUPP.py.in --- arpack-3.7.0/EXAMPLES/PYARPACK/pyarpackDenseLUPP.py.in 1970-01-01 00:00:00.000000000 +0000 +++ arpack-3.8.0/EXAMPLES/PYARPACK/pyarpackDenseLUPP.py.in 2020-12-07 10:40:45.000000000 +0000 @@ -0,0 +1,109 @@ +#!/usr/bin/env python + +import numpy as np +from pyarpack import denseLUPP as pyarpackSlv + +# Build laplacian. + +n = 4 +Aij = np.array([], dtype='float64') +for k in range(n): + for l in range(n): + if l == k: + Aij = np.append(Aij, np.float64( 200.)) # Casting value on append is MANDATORY or C++ won't get the expected type. + elif l == k-1 or l == k+1: + Aij = np.append(Aij, np.float64(-100.)) # Casting value on append is MANDATORY or C++ won't get the expected type. + else: + Aij = np.append(Aij, np.float64( 0.)) # Casting value on append is MANDATORY or C++ won't get the expected type. +for idx, val in enumerate(Aij): + print("A[", idx, "] =", val) +A = (Aij, False) # raw format: Aij values, row ordered (or not). + +# Get and tune arpack solver. + +arpackSlv = pyarpackSlv.double() # Caution: double <=> np.array(..., dtype='float64') +arpackSlv.verbose = 3 # Set to 0 to get a quiet solve. +arpackSlv.debug = 1 # Set to 0 to get a quiet solve. +arpackSlv.nbEV = 1 +arpackSlv.nbCV = 2*arpackSlv.nbEV + 1 +arpackSlv.mag = 'LM' +arpackSlv.maxIt = 200 +arpackSlv.slvPvtThd = 1.e-6 + +# Solve eigen problem. + +rc = arpackSlv.solve(A) +assert rc == 0, "bad solve" +rc = arpackSlv.checkEigVec(A) +assert rc == 0, "bad checkEigVec" + +# Print out results (mode selected, eigen vectors, eigen values, ...). + +assert arpackSlv.nbEV == len(arpackSlv.val), "bad result" +print("\nresults:\n") +print("mode selected:", arpackSlv.mode) +print("nb iterations:", arpackSlv.nbIt) +print("Reverse Communication Interface time:", arpackSlv.rciTime, "s") +for val, vec in zip(arpackSlv.val, arpackSlv.vec): + print("eigen value:", val) + print("eigen vector:") + print(vec) + +####################################################################################### +print("\n##########################################################################\n") +####################################################################################### + +# Build laplacian. + +n = 8 +Aij = np.array([], dtype='float32') +Bij = np.array([], dtype='float32') +for k in range(n): + for l in range(n): + if l == k: + Aij = np.append(Aij, np.float32( 200.)) # Casting value on append is MANDATORY or C++ won't get the expected type. + Bij = np.append(Bij, np.float32( 33.3)) # Casting value on append is MANDATORY or C++ won't get the expected type. + elif l == k-1 or l == k+1: + Aij = np.append(Aij, np.float32(-100.)) # Casting value on append is MANDATORY or C++ won't get the expected type. + Bij = np.append(Bij, np.float32( 16.6)) # Casting value on append is MANDATORY or C++ won't get the expected type. + else: + Aij = np.append(Aij, np.float32( 0.)) # Casting value on append is MANDATORY or C++ won't get the expected type. + Bij = np.append(Bij, np.float32( 0.)) # Casting value on append is MANDATORY or C++ won't get the expected type. +for idx, val in enumerate(Aij): + print("A[", idx, "] =", val) +for idx, val in enumerate(Bij): + print("B[", idx, "] =", val) +A = (Aij, False) # raw format: Aij values, row ordered (or not). +B = (Bij, True) # raw format: Bij values, row ordered (or not). + +# Get and tune arpack solver. + +arpackSlv = pyarpackSlv.float() # Caution: float <=> np.array(..., dtype='float32') +arpackSlv.verbose = 3 # Set to 0 to get a quiet solve. +arpackSlv.debug = 1 # Set to 0 to get a quiet solve. +arpackSlv.nbEV = 2 +arpackSlv.nbCV = 2*arpackSlv.nbEV + 1 +arpackSlv.mag = 'LM' +arpackSlv.maxIt = 200 +arpackSlv.slvPvtThd = 1.e-6 +arpackSlv.sigmaReal = 1 + +# Solve eigen problem. + +rc = arpackSlv.solve(A, B) +assert rc == 0, "bad solve" +rc = arpackSlv.checkEigVec(A, B, 1.e-2) +assert rc == 0, "bad checkEigVec" + +# Print out results (mode selected, eigen vectors, eigen values, ...). + +assert arpackSlv.nbEV == len(arpackSlv.val), "bad result" +print("\nresults:\n") +print("mode selected:", arpackSlv.mode) +print("nb iterations:", arpackSlv.nbIt) +print("Reverse Communication Interface time:", arpackSlv.rciTime, "s") +for val, vec in zip(arpackSlv.val, arpackSlv.vec): + print("eigen value:", val) + print("eigen vector:") + for v in range(n): + print(vec[v]) diff -Nru arpack-3.7.0/EXAMPLES/PYARPACK/pyarpackDenseLURR.py.in arpack-3.8.0/EXAMPLES/PYARPACK/pyarpackDenseLURR.py.in --- arpack-3.7.0/EXAMPLES/PYARPACK/pyarpackDenseLURR.py.in 1970-01-01 00:00:00.000000000 +0000 +++ arpack-3.8.0/EXAMPLES/PYARPACK/pyarpackDenseLURR.py.in 2020-12-07 10:40:45.000000000 +0000 @@ -0,0 +1,109 @@ +#!/usr/bin/env python + +import numpy as np +from pyarpack import denseLURR as pyarpackSlv + +# Build laplacian. + +n = 4 +Aij = np.array([], dtype='float64') +for k in range(n): + for l in range(n): + if l == k: + Aij = np.append(Aij, np.float64( 200.)) # Casting value on append is MANDATORY or C++ won't get the expected type. + elif l == k-1 or l == k+1: + Aij = np.append(Aij, np.float64(-100.)) # Casting value on append is MANDATORY or C++ won't get the expected type. + else: + Aij = np.append(Aij, np.float64( 0.)) # Casting value on append is MANDATORY or C++ won't get the expected type. +for idx, val in enumerate(Aij): + print("A[", idx, "] =", val) +A = (Aij, False) # raw format: Aij values, row ordered (or not). + +# Get and tune arpack solver. + +arpackSlv = pyarpackSlv.double() # Caution: double <=> np.array(..., dtype='float64') +arpackSlv.verbose = 3 # Set to 0 to get a quiet solve. +arpackSlv.debug = 1 # Set to 0 to get a quiet solve. +arpackSlv.nbEV = 1 +arpackSlv.nbCV = 2*arpackSlv.nbEV + 1 +arpackSlv.mag = 'LM' +arpackSlv.maxIt = 200 +arpackSlv.slvPvtThd = 1.e-6 + +# Solve eigen problem. + +rc = arpackSlv.solve(A) +assert rc == 0, "bad solve" +rc = arpackSlv.checkEigVec(A) +assert rc == 0, "bad checkEigVec" + +# Print out results (mode selected, eigen vectors, eigen values, ...). + +assert arpackSlv.nbEV == len(arpackSlv.val), "bad result" +print("\nresults:\n") +print("mode selected:", arpackSlv.mode) +print("nb iterations:", arpackSlv.nbIt) +print("Reverse Communication Interface time:", arpackSlv.rciTime, "s") +for val, vec in zip(arpackSlv.val, arpackSlv.vec): + print("eigen value:", val) + print("eigen vector:") + print(vec) + +####################################################################################### +print("\n##########################################################################\n") +####################################################################################### + +# Build laplacian. + +n = 8 +Aij = np.array([], dtype='float32') +Bij = np.array([], dtype='float32') +for k in range(n): + for l in range(n): + if l == k: + Aij = np.append(Aij, np.float32( 200.)) # Casting value on append is MANDATORY or C++ won't get the expected type. + Bij = np.append(Bij, np.float32( 33.3)) # Casting value on append is MANDATORY or C++ won't get the expected type. + elif l == k-1 or l == k+1: + Aij = np.append(Aij, np.float32(-100.)) # Casting value on append is MANDATORY or C++ won't get the expected type. + Bij = np.append(Bij, np.float32( 16.6)) # Casting value on append is MANDATORY or C++ won't get the expected type. + else: + Aij = np.append(Aij, np.float32( 0.)) # Casting value on append is MANDATORY or C++ won't get the expected type. + Bij = np.append(Bij, np.float32( 0.)) # Casting value on append is MANDATORY or C++ won't get the expected type. +for idx, val in enumerate(Aij): + print("A[", idx, "] =", val) +for idx, val in enumerate(Bij): + print("B[", idx, "] =", val) +A = (Aij, False) # raw format: Aij values, row ordered (or not). +B = (Bij, True) # raw format: Bij values, row ordered (or not). + +# Get and tune arpack solver. + +arpackSlv = pyarpackSlv.float() # Caution: float <=> np.array(..., dtype='float32') +arpackSlv.verbose = 3 # Set to 0 to get a quiet solve. +arpackSlv.debug = 1 # Set to 0 to get a quiet solve. +arpackSlv.nbEV = 2 +arpackSlv.nbCV = 2*arpackSlv.nbEV + 1 +arpackSlv.mag = 'LM' +arpackSlv.maxIt = 200 +arpackSlv.slvPvtThd = 1.e-6 +arpackSlv.sigmaReal = 1 + +# Solve eigen problem. + +rc = arpackSlv.solve(A, B) +assert rc == 0, "bad solve" +rc = arpackSlv.checkEigVec(A, B, 1.e-2) +assert rc == 0, "bad checkEigVec" + +# Print out results (mode selected, eigen vectors, eigen values, ...). + +assert arpackSlv.nbEV == len(arpackSlv.val), "bad result" +print("\nresults:\n") +print("mode selected:", arpackSlv.mode) +print("nb iterations:", arpackSlv.nbIt) +print("Reverse Communication Interface time:", arpackSlv.rciTime, "s") +for val, vec in zip(arpackSlv.val, arpackSlv.vec): + print("eigen value:", val) + print("eigen vector:") + for v in range(n): + print(vec[v]) diff -Nru arpack-3.7.0/EXAMPLES/PYARPACK/pyarpackDenseQRPP.py.in arpack-3.8.0/EXAMPLES/PYARPACK/pyarpackDenseQRPP.py.in --- arpack-3.7.0/EXAMPLES/PYARPACK/pyarpackDenseQRPP.py.in 1970-01-01 00:00:00.000000000 +0000 +++ arpack-3.8.0/EXAMPLES/PYARPACK/pyarpackDenseQRPP.py.in 2020-12-07 10:40:45.000000000 +0000 @@ -0,0 +1,116 @@ +#!/usr/bin/env python + +import numpy as np +from pyarpack import denseQRPP as pyarpackSlv + +# Build laplacian. + +n = 4 +Aij = np.array([], dtype='complex128') +for k in range(n): + for l in range(n): + if l == k: + Aij = np.append(Aij, np.complex128(np.complex( 200., 200.))) # Casting value on append is MANDATORY or C++ won't get the expected type. + elif l == k-1: + Aij = np.append(Aij, np.complex128(np.complex(-101., -101.))) # Casting value on append is MANDATORY or C++ won't get the expected type. + elif l == k+1: + Aij = np.append(Aij, np.complex128(np.complex( -99., -99.))) # Casting value on append is MANDATORY or C++ won't get the expected type. + else: + Aij = np.append(Aij, np.complex128(np.complex( 0., 0.))) # Casting value on append is MANDATORY or C++ won't get the expected type. +for idx, val in enumerate(Aij): + print("A[", idx, "] =", val) +A = (Aij, False) # raw format: Aij values, row ordered (or not). + +# Get and tune arpack solver. + +arpackSlv = pyarpackSlv.complexDouble() # Caution: complexDouble <=> np.array(..., dtype='complex128') +arpackSlv.verbose = 3 # Set to 0 to get a quiet solve. +arpackSlv.debug = 1 # Set to 0 to get a quiet solve. +arpackSlv.nbEV = 1 +arpackSlv.nbCV = 2*arpackSlv.nbEV + 1 +arpackSlv.mag = 'LM' +arpackSlv.maxIt = 200 +arpackSlv.slvPvtThd = 1.e-6 +arpackSlv.symPb = False + +# Solve eigen problem. + +rc = arpackSlv.solve(A) +assert rc == 0, "bad solve" +rc = arpackSlv.checkEigVec(A) +assert rc == 0, "bad checkEigVec" + +# Print out results (mode selected, eigen vectors, eigen values, ...). + +assert arpackSlv.nbEV == len(arpackSlv.val), "bad result" +print("\nresults:\n") +print("mode selected:", arpackSlv.mode) +print("nb iterations:", arpackSlv.nbIt) +print("Reverse Communication Interface time:", arpackSlv.rciTime, "s") +for val, vec in zip(arpackSlv.val, arpackSlv.vec): + print("eigen value:", val) + print("eigen vector:") + print(vec) + +####################################################################################### +print("\n##########################################################################\n") +####################################################################################### + +# Build laplacian. + +n = 8 +Aij = np.array([], dtype='complex64') +Bij = np.array([], dtype='complex64') +for k in range(n): + for l in range(n): + if l == k: + Aij = np.append(Aij, np.complex64(np.complex( 200., 200.))) # Casting value on append is MANDATORY or C++ won't get the expected type. + Bij = np.append(Bij, np.complex64(np.complex( 33.3, 33.3))) # Casting value on append is MANDATORY or C++ won't get the expected type. + elif l == k-1: + Aij = np.append(Aij, np.complex64(np.complex(-101., -101.))) # Casting value on append is MANDATORY or C++ won't get the expected type. + Bij = np.append(Bij, np.complex64(np.complex( 16.6, 16.6))) # Casting value on append is MANDATORY or C++ won't get the expected type. + elif l == k+1: + Aij = np.append(Aij, np.complex64(np.complex( -99., -99.))) # Casting value on append is MANDATORY or C++ won't get the expected type. + Bij = np.append(Bij, np.complex64(np.complex( 16.6, 16.6))) # Casting value on append is MANDATORY or C++ won't get the expected type. + else: + Aij = np.append(Aij, np.complex64(np.complex( 0., 0.))) # Casting value on append is MANDATORY or C++ won't get the expected type. + Bij = np.append(Bij, np.complex64(np.complex( 0., 0.))) # Casting value on append is MANDATORY or C++ won't get the expected type. +for idx, val in enumerate(Aij): + print("A[", idx, "] =", val) +for idx, val in enumerate(Bij): + print("B[", idx, "] =", val) +A = (Aij, False) # raw format: Aij values, row ordered (or not). +B = (Bij, True) # raw format: Bij values, row ordered (or not). + +# Get and tune arpack solver. + +arpackSlv = pyarpackSlv.complexFloat() # Caution: complexFloat <=> np.array(..., dtype='complex64') +arpackSlv.verbose = 3 # Set to 0 to get a quiet solve. +arpackSlv.debug = 1 # Set to 0 to get a quiet solve. +arpackSlv.nbEV = 2 +arpackSlv.nbCV = 2*arpackSlv.nbEV + 1 +arpackSlv.mag = 'LM' +arpackSlv.maxIt = 200 +arpackSlv.slvPvtThd = 1.e-6 +arpackSlv.sigmaReal = 1 +arpackSlv.symPb = False + +# Solve eigen problem. + +rc = arpackSlv.solve(A, B) +assert rc == 0, "bad solve" +rc = arpackSlv.checkEigVec(A, B, 1.e-2) +assert rc == 0, "bad checkEigVec" + +# Print out results (mode selected, eigen vectors, eigen values, ...). + +assert arpackSlv.nbEV == len(arpackSlv.val), "bad result" +print("\nresults:\n") +print("mode selected:", arpackSlv.mode) +print("nb iterations:", arpackSlv.nbIt) +print("Reverse Communication Interface time:", arpackSlv.rciTime, "s") +for val, vec in zip(arpackSlv.val, arpackSlv.vec): + print("eigen value:", val) + print("eigen vector:") + for v in range(n): + print(vec[v]) diff -Nru arpack-3.7.0/EXAMPLES/PYARPACK/pyarpackDenseQRRR.py.in arpack-3.8.0/EXAMPLES/PYARPACK/pyarpackDenseQRRR.py.in --- arpack-3.7.0/EXAMPLES/PYARPACK/pyarpackDenseQRRR.py.in 1970-01-01 00:00:00.000000000 +0000 +++ arpack-3.8.0/EXAMPLES/PYARPACK/pyarpackDenseQRRR.py.in 2020-12-07 10:40:45.000000000 +0000 @@ -0,0 +1,116 @@ +#!/usr/bin/env python + +import numpy as np +from pyarpack import denseQRRR as pyarpackSlv + +# Build laplacian. + +n = 4 +Aij = np.array([], dtype='complex128') +for k in range(n): + for l in range(n): + if l == k: + Aij = np.append(Aij, np.complex128(np.complex( 200., 200.))) # Casting value on append is MANDATORY or C++ won't get the expected type. + elif l == k-1: + Aij = np.append(Aij, np.complex128(np.complex(-101., -101.))) # Casting value on append is MANDATORY or C++ won't get the expected type. + elif l == k+1: + Aij = np.append(Aij, np.complex128(np.complex( -99., -99.))) # Casting value on append is MANDATORY or C++ won't get the expected type. + else: + Aij = np.append(Aij, np.complex128(np.complex( 0., 0.))) # Casting value on append is MANDATORY or C++ won't get the expected type. +for idx, val in enumerate(Aij): + print("A[", idx, "] =", val) +A = (Aij, False) # raw format: Aij values, row ordered (or not). + +# Get and tune arpack solver. + +arpackSlv = pyarpackSlv.complexDouble() # Caution: complexDouble <=> np.array(..., dtype='complex128') +arpackSlv.verbose = 3 # Set to 0 to get a quiet solve. +arpackSlv.debug = 1 # Set to 0 to get a quiet solve. +arpackSlv.nbEV = 1 +arpackSlv.nbCV = 2*arpackSlv.nbEV + 1 +arpackSlv.mag = 'LM' +arpackSlv.maxIt = 200 +arpackSlv.slvPvtThd = 1.e-6 +arpackSlv.symPb = False + +# Solve eigen problem. + +rc = arpackSlv.solve(A) +assert rc == 0, "bad solve" +rc = arpackSlv.checkEigVec(A) +assert rc == 0, "bad checkEigVec" + +# Print out results (mode selected, eigen vectors, eigen values, ...). + +assert arpackSlv.nbEV == len(arpackSlv.val), "bad result" +print("\nresults:\n") +print("mode selected:", arpackSlv.mode) +print("nb iterations:", arpackSlv.nbIt) +print("Reverse Communication Interface time:", arpackSlv.rciTime, "s") +for val, vec in zip(arpackSlv.val, arpackSlv.vec): + print("eigen value:", val) + print("eigen vector:") + print(vec) + +####################################################################################### +print("\n##########################################################################\n") +####################################################################################### + +# Build laplacian. + +n = 8 +Aij = np.array([], dtype='complex64') +Bij = np.array([], dtype='complex64') +for k in range(n): + for l in range(n): + if l == k: + Aij = np.append(Aij, np.complex64(np.complex( 200., 200.))) # Casting value on append is MANDATORY or C++ won't get the expected type. + Bij = np.append(Bij, np.complex64(np.complex( 33.3, 33.3))) # Casting value on append is MANDATORY or C++ won't get the expected type. + elif l == k-1: + Aij = np.append(Aij, np.complex64(np.complex(-101., -101.))) # Casting value on append is MANDATORY or C++ won't get the expected type. + Bij = np.append(Bij, np.complex64(np.complex( 16.6, 16.6))) # Casting value on append is MANDATORY or C++ won't get the expected type. + elif l == k+1: + Aij = np.append(Aij, np.complex64(np.complex( -99., -99.))) # Casting value on append is MANDATORY or C++ won't get the expected type. + Bij = np.append(Bij, np.complex64(np.complex( 16.6, 16.6))) # Casting value on append is MANDATORY or C++ won't get the expected type. + else: + Aij = np.append(Aij, np.complex64(np.complex( 0., 0.))) # Casting value on append is MANDATORY or C++ won't get the expected type. + Bij = np.append(Bij, np.complex64(np.complex( 0., 0.))) # Casting value on append is MANDATORY or C++ won't get the expected type. +for idx, val in enumerate(Aij): + print("A[", idx, "] =", val) +for idx, val in enumerate(Bij): + print("B[", idx, "] =", val) +A = (Aij, False) # raw format: Aij values, row ordered (or not). +B = (Bij, True) # raw format: Bij values, row ordered (or not). + +# Get and tune arpack solver. + +arpackSlv = pyarpackSlv.complexFloat() # Caution: complexFloat <=> np.array(..., dtype='complex64') +arpackSlv.verbose = 3 # Set to 0 to get a quiet solve. +arpackSlv.debug = 1 # Set to 0 to get a quiet solve. +arpackSlv.nbEV = 2 +arpackSlv.nbCV = 2*arpackSlv.nbEV + 1 +arpackSlv.mag = 'LM' +arpackSlv.maxIt = 200 +arpackSlv.slvPvtThd = 1.e-6 +arpackSlv.sigmaReal = 1 +arpackSlv.symPb = False + +# Solve eigen problem. + +rc = arpackSlv.solve(A, B) +assert rc == 0, "bad solve" +rc = arpackSlv.checkEigVec(A, B, 1.e-2) +assert rc == 0, "bad checkEigVec" + +# Print out results (mode selected, eigen vectors, eigen values, ...). + +assert arpackSlv.nbEV == len(arpackSlv.val), "bad result" +print("\nresults:\n") +print("mode selected:", arpackSlv.mode) +print("nb iterations:", arpackSlv.nbIt) +print("Reverse Communication Interface time:", arpackSlv.rciTime, "s") +for val, vec in zip(arpackSlv.val, arpackSlv.vec): + print("eigen value:", val) + print("eigen vector:") + for v in range(n): + print(vec[v]) diff -Nru arpack-3.7.0/EXAMPLES/PYARPACK/pyarpackDrtSolver.hpp arpack-3.8.0/EXAMPLES/PYARPACK/pyarpackDrtSolver.hpp --- arpack-3.7.0/EXAMPLES/PYARPACK/pyarpackDrtSolver.hpp 1970-01-01 00:00:00.000000000 +0000 +++ arpack-3.8.0/EXAMPLES/PYARPACK/pyarpackDrtSolver.hpp 2020-12-07 10:40:45.000000000 +0000 @@ -0,0 +1,138 @@ +#ifndef __PYARPACKDRTSOLVER_HPP__ +#define __PYARPACKDRTSOLVER_HPP__ + +#include + +#include +#include +#include "debug_c.hpp" +#include "stat_c.hpp" + +#include +#include + +namespace bp = boost::python; +namespace bn = boost::python::numpy; + +template +class pyarpackSparseDrtSolver: public arpackDrtSolver { + // Public methods. + + public: + + pyarpackSparseDrtSolver(): arpackDrtSolver() { + debug = 0; + + nopx = 0, nbx = 0, nrorth = 0, nitref = 0, nrstrt = 0; + tsaupd = 0., tsaup2 = 0., tsaitr = 0., tseigt = 0., tsgets = 0., tsapps = 0., tsconv = 0.; + tnaupd = 0., tnaup2 = 0., tnaitr = 0., tneigt = 0., tngets = 0., tnapps = 0., tnconv = 0.; + tcaupd = 0., tcaup2 = 0., tcaitr = 0., tceigt = 0., tcgets = 0., tcapps = 0., tcconv = 0.; + tmvopx = 0., tmvbx = 0., tgetv0 = 0., titref = 0., trvec = 0.; + }; + + int solve(bp::tuple & A, bp::tuple B = bp::tuple()) { + ARPACKSOLVERDEBUGSTAT(); + EM M; + int rc = pyarpackServices::buildSparseMatrice(A, M, debug, "A"); + if (rc != 0) {pyarpackThrowError("build matrice from A KO"); return rc;} + bool stdPb = (bp::len(B) > 0) ? false : true; + EM N; + if (!stdPb) { + rc = pyarpackServices::buildSparseMatrice(B, N, debug, "B"); + if (rc != 0) {pyarpackThrowError("build matrice from B KO"); return rc;} + } + return arpackDrtSolver::solve(M, (stdPb ? NULL : &N)); + }; + + int checkEigVec(bp::tuple const & A, bp::tuple const B = bp::tuple(), double const diffTol = 1.e-3) { + ARPACKSOLVERDEBUGSTAT(); + EM M; + int rc = pyarpackServices::buildSparseMatrice(A, M, debug, "A"); + if (rc != 0) {pyarpackThrowError("build matrice from A KO"); return rc;} + bool stdPb = (bp::len(B) > 0) ? false : true; + EM N; + if (!stdPb) { + rc = pyarpackServices::buildSparseMatrice(B, N, debug, "B"); + if (rc != 0) {pyarpackThrowError("build matrice from B KO"); return rc;} + } + return arpackDrtSolver::checkEigVec(M, (stdPb ? NULL : &N), &diffTol); + }; + + // Public members. + + public: + + a_int debug; + + a_int nopx, nbx, nrorth, nitref, nrstrt; + float tsaupd, tsaup2, tsaitr, tseigt, tsgets, tsapps, tsconv; + float tnaupd, tnaup2, tnaitr, tneigt, tngets, tnapps, tnconv; + float tcaupd, tcaup2, tcaitr, tceigt, tcgets, tcapps, tcconv; + float tmvopx, tmvbx, tgetv0, titref, trvec; +}; + +template +class pyarpackDenseDrtSolver: public arpackDrtSolver { + // Public methods. + + public: + + pyarpackDenseDrtSolver(): arpackDrtSolver() { + debug = 0; + + nopx = 0, nbx = 0, nrorth = 0, nitref = 0, nrstrt = 0; + tsaupd = 0., tsaup2 = 0., tsaitr = 0., tseigt = 0., tsgets = 0., tsapps = 0., tsconv = 0.; + tnaupd = 0., tnaup2 = 0., tnaitr = 0., tneigt = 0., tngets = 0., tnapps = 0., tnconv = 0.; + tcaupd = 0., tcaup2 = 0., tcaitr = 0., tceigt = 0., tcgets = 0., tcapps = 0., tcconv = 0.; + tmvopx = 0., tmvbx = 0., tgetv0 = 0., titref = 0., trvec = 0.; + }; + + int solve(bp::tuple & A, bp::tuple B = bp::tuple()) { + ARPACKSOLVERDEBUGSTAT(); + EM M; + int rc = pyarpackServices::buildDenseMatrice(A, M, debug, "A"); + if (rc != 0) {pyarpackThrowError("build matrice from A KO"); return rc;} + bool stdPb = (bp::len(B) > 0) ? false : true; + EM N; + if (!stdPb) { + rc = pyarpackServices::buildDenseMatrice(B, N, debug, "B"); + if (rc != 0) {pyarpackThrowError("build matrice from B KO"); return rc;} + } + return arpackDrtSolver::solve(M, (stdPb ? NULL : &N)); + }; + + int checkEigVec(bp::tuple const & A, bp::tuple const B = bp::tuple(), double const diffTol = 1.e-3) { + ARPACKSOLVERDEBUGSTAT(); + EM M; + int rc = pyarpackServices::buildDenseMatrice(A, M, debug, "A"); + if (rc != 0) {pyarpackThrowError("build matrice from A KO"); return rc;} + bool stdPb = (bp::len(B) > 0) ? false : true; + EM N; + if (!stdPb) { + rc = pyarpackServices::buildDenseMatrice(B, N, debug, "B"); + if (rc != 0) {pyarpackThrowError("build matrice from B KO"); return rc;} + } + return arpackDrtSolver::checkEigVec(M, (stdPb ? NULL : &N), &diffTol); + }; + + // Public members. + + public: + + a_int debug; + + a_int nopx, nbx, nrorth, nitref, nrstrt; + float tsaupd, tsaup2, tsaitr, tseigt, tsgets, tsapps, tsconv; + float tnaupd, tnaup2, tnaitr, tneigt, tngets, tnapps, tnconv; + float tcaupd, tcaup2, tcaitr, tceigt, tcgets, tcapps, tcconv; + float tmvopx, tmvbx, tgetv0, titref, trvec; +}; + +#endif + +// Local Variables: +// mode: c++ +// c-file-style:"stroustrup" +// show-trailing-whitespace: t +// End: +/* vim: set sw=2 ts=2 et smartindent :*/ diff -Nru arpack-3.7.0/EXAMPLES/PYARPACK/pyarpackItrSolver.hpp arpack-3.8.0/EXAMPLES/PYARPACK/pyarpackItrSolver.hpp --- arpack-3.7.0/EXAMPLES/PYARPACK/pyarpackItrSolver.hpp 1970-01-01 00:00:00.000000000 +0000 +++ arpack-3.8.0/EXAMPLES/PYARPACK/pyarpackItrSolver.hpp 2020-12-07 10:40:45.000000000 +0000 @@ -0,0 +1,80 @@ +#ifndef __PYARPACKITRSOLVER_HPP__ +#define __PYARPACKITRSOLVER_HPP__ + +#include + +#include +#include +#include "debug_c.hpp" +#include "stat_c.hpp" + +#include +#include + +namespace bp = boost::python; + +template +class pyarpackSparseItrSolver: public arpackItrSolver { + // Public methods. + + public: + + pyarpackSparseItrSolver(): arpackItrSolver() { + debug = 0; + + nopx = 0, nbx = 0, nrorth = 0, nitref = 0, nrstrt = 0; + tsaupd = 0., tsaup2 = 0., tsaitr = 0., tseigt = 0., tsgets = 0., tsapps = 0., tsconv = 0.; + tnaupd = 0., tnaup2 = 0., tnaitr = 0., tneigt = 0., tngets = 0., tnapps = 0., tnconv = 0.; + tcaupd = 0., tcaup2 = 0., tcaitr = 0., tceigt = 0., tcgets = 0., tcapps = 0., tcconv = 0.; + tmvopx = 0., tmvbx = 0., tgetv0 = 0., titref = 0., trvec = 0.; + }; + + int solve(bp::tuple & A, bp::tuple B = bp::tuple()) { + ARPACKSOLVERDEBUGSTAT(); + EM M; + int rc = pyarpackServices::buildSparseMatrice(A, M, debug, "A"); + if (rc != 0) {pyarpackThrowError("build matrice from A KO"); return rc;} + bool stdPb = (bp::len(B) > 0) ? false : true; + EM N; + if (!stdPb) { + rc = pyarpackServices::buildSparseMatrice(B, N, debug, "B"); + if (rc != 0) {pyarpackThrowError("build matrice from B KO"); return rc;} + } + return arpackItrSolver::solve(M, (stdPb ? NULL : &N)); + }; + + int checkEigVec(bp::tuple const & A, bp::tuple const B = bp::tuple(), double const diffTol = 1.e-3) { + ARPACKSOLVERDEBUGSTAT(); + EM M; + int rc = pyarpackServices::buildSparseMatrice(A, M, debug, "A"); + if (rc != 0) {pyarpackThrowError("build matrice from A KO"); return rc;} + bool stdPb = (bp::len(B) > 0) ? false : true; + EM N; + if (!stdPb) { + rc = pyarpackServices::buildSparseMatrice(B, N, debug, "B"); + if (rc != 0) {pyarpackThrowError("build matrice from B KO"); return rc;} + } + return arpackItrSolver::checkEigVec(M, (stdPb ? NULL : &N), &diffTol); + }; + + // Public members. + + public: + + a_int debug; + + a_int nopx, nbx, nrorth, nitref, nrstrt; + float tsaupd, tsaup2, tsaitr, tseigt, tsgets, tsapps, tsconv; + float tnaupd, tnaup2, tnaitr, tneigt, tngets, tnapps, tnconv; + float tcaupd, tcaup2, tcaitr, tceigt, tcgets, tcapps, tcconv; + float tmvopx, tmvbx, tgetv0, titref, trvec; +}; + +#endif + +// Local Variables: +// mode: c++ +// c-file-style:"stroustrup" +// show-trailing-whitespace: t +// End: +/* vim: set sw=2 ts=2 et smartindent :*/ diff -Nru arpack-3.7.0/EXAMPLES/PYARPACK/pyarpackRestart.py.in arpack-3.8.0/EXAMPLES/PYARPACK/pyarpackRestart.py.in --- arpack-3.7.0/EXAMPLES/PYARPACK/pyarpackRestart.py.in 1970-01-01 00:00:00.000000000 +0000 +++ arpack-3.8.0/EXAMPLES/PYARPACK/pyarpackRestart.py.in 2020-12-07 10:40:45.000000000 +0000 @@ -0,0 +1,119 @@ +#!/usr/bin/env python + +import numpy as np +from pyarpack import sparseBiCGDiag as pyarpackSlv + +# Build laplacian. + +n = 8 +i = np.array([], dtype='@PYINT@') +j = np.array([], dtype='@PYINT@') +Aij = np.array([], dtype='float64') +for k in range(n): + for l in [k-1, k, k+1]: + if l < 0 or l > n-1: + continue + i = np.append(i, np.@PYINT@(k)) # Casting value on append is MANDATORY or C++ won't get the expected type. + j = np.append(j, np.@PYINT@(l)) # Casting value on append is MANDATORY or C++ won't get the expected type. + if l == k: + Aij = np.append(Aij, np.float64( 200.)) # Casting value on append is MANDATORY or C++ won't get the expected type. + if l == k-1 or l == k+1: + Aij = np.append(Aij, np.float64(-100.)) # Casting value on append is MANDATORY or C++ won't get the expected type. +for k, l, Akl in zip(i, j, Aij): + print("A[", k, ",", l, "] =", Akl) +A = (n, i, j, Aij) # coo format: dimension, i 0-based indices, j 0-based indices, Aij values. + +# Get and tune arpack solver. + +arpackSlv = pyarpackSlv.double() # Caution: double <=> np.array(..., dtype='float64') +arpackSlv.verbose = 3 # Set to 0 to get a quiet solve. +arpackSlv.debug = 1 # Set to 0 to get a quiet solve. +arpackSlv.nbEV = 1 +arpackSlv.nbCV = 2*arpackSlv.nbEV + 1 +arpackSlv.mag = 'LM' +arpackSlv.maxIt = 200 +arpackSlv.slvTol = 1.e-6 +arpackSlv.slvMaxIt = 100 +arpackSlv.dumpToFile = True # Dump eigen vectors to arpackSolver.*.out files. +arpackSlv.schur = True # Schur vectors and eigenvectors of A are the same if A is a normal matrix. + +# Solve eigen problem. + +rc = arpackSlv.solve(A) +assert rc == 0, "bad solve" +rc = arpackSlv.checkEigVec(A) +assert rc == 0, "bad checkEigVec" + +nbIt1 = arpackSlv.nbIt + +# Print out results (mode selected, eigen vectors, eigen values, ...). + +assert arpackSlv.nbEV == len(arpackSlv.val), "bad result" +print("\nresults:\n") +print("mode selected:", arpackSlv.mode) +print("nb iterations:", arpackSlv.nbIt) +print("Reverse Communication Interface time:", arpackSlv.rciTime, "s") +for val, vec in zip(arpackSlv.val, arpackSlv.vec): + print("eigen value:", val) + print("eigen vector:") + print(vec) + +####################################################################################### +print("\n##########################################################################\n") +####################################################################################### + +# Build laplacian (similar-but-different from the previous one). + +n = 8 +i = np.array([], dtype='@PYINT@') +j = np.array([], dtype='@PYINT@') +Aij = np.array([], dtype='float64') +for k in range(n): + for l in [k-1, k, k+1]: + if l < 0 or l > n-1: + continue + i = np.append(i, np.@PYINT@(k)) # Casting value on append is MANDATORY or C++ won't get the expected type. + j = np.append(j, np.@PYINT@(l)) # Casting value on append is MANDATORY or C++ won't get the expected type. + if l == k: + Aij = np.append(Aij, np.float64( 210.)) # Casting value on append is MANDATORY or C++ won't get the expected type. + if l == k-1 or l == k+1: + Aij = np.append(Aij, np.float64( -90.)) # Casting value on append is MANDATORY or C++ won't get the expected type. +for k, l, Akl in zip(i, j, Aij): + print("A[", k, ",", l, "] =", Akl) +A = (n, i, j, Aij) # coo format: dimension, i 0-based indices, j 0-based indices, Aij values. + +# Get and tune arpack solver. + +arpackSlv = pyarpackSlv.double() # Caution: double <=> np.array(..., dtype='float64') +arpackSlv.verbose = 3 # Set to 0 to get a quiet solve. +arpackSlv.debug = 1 # Set to 0 to get a quiet solve. +arpackSlv.nbEV = 1 +arpackSlv.nbCV = 2*arpackSlv.nbEV + 1 +arpackSlv.mag = 'LM' +arpackSlv.maxIt = 200 +arpackSlv.slvTol = 1.e-6 +arpackSlv.slvMaxIt = 100 +arpackSlv.restartFromFile = True # Restart from eigen vectors found in arpackSolver.*.out files. +arpackSlv.schur = True # Schur vectors and eigenvectors of A are the same if A is a normal matrix. + +# Solve eigen problem. + +rc = arpackSlv.solve(A) +assert rc == 0, "bad solve" +rc = arpackSlv.checkEigVec(A) +assert rc == 0, "bad checkEigVec" + +nbIt2 = arpackSlv.nbIt +assert nbIt2 < nbIt1, "bad restart" # Restart from the first solve to run the second solve for a similar-but-different A. + +# Print out results (mode selected, eigen vectors, eigen values, ...). + +assert arpackSlv.nbEV == len(arpackSlv.val), "bad result" +print("\nresults:\n") +print("mode selected:", arpackSlv.mode) +print("nb iterations:", arpackSlv.nbIt) +print("Reverse Communication Interface time:", arpackSlv.rciTime, "s") +for val, vec in zip(arpackSlv.val, arpackSlv.vec): + print("eigen value:", val) + print("eigen vector:") + print(vec) diff -Nru arpack-3.7.0/EXAMPLES/PYARPACK/pyarpackServices.hpp arpack-3.8.0/EXAMPLES/PYARPACK/pyarpackServices.hpp --- arpack-3.7.0/EXAMPLES/PYARPACK/pyarpackServices.hpp 1970-01-01 00:00:00.000000000 +0000 +++ arpack-3.8.0/EXAMPLES/PYARPACK/pyarpackServices.hpp 2020-12-07 10:40:45.000000000 +0000 @@ -0,0 +1,194 @@ +#ifndef __PYARPACKSERVICES_HPP__ +#define __PYARPACKSERVICES_HPP__ + +#include +#include +#include +#include +#include // sqrt. + +#include + +#include +#include + +namespace bp = boost::python; +namespace bn = boost::python::numpy; + +#define ARPACKSOLVERMEMBER(pyarpackSolver) \ + .def_readwrite("symPb", &pyarpackSolver::symPb, \ + "symmetric problem - default: true") \ + .def_readwrite("nbEV", &pyarpackSolver::nbEV, \ + "number of eigen vectors to find - default: 1") \ + .def_readwrite("nbCV", &pyarpackSolver::nbCV, \ + "number of dimensions of the workspace - default: 3") \ + .def_readwrite("tol", &pyarpackSolver::tol, \ + "tolerance - default: 1.e-6") \ + .def_readwrite("sigmaReal", &pyarpackSolver::sigmaReal, \ + "shift over real axis - default: 0.") \ + .def_readwrite("sigmaImag", &pyarpackSolver::sigmaImag, \ + "shift over imaginary axis - default: 0.") \ + .def_readwrite("dumpToFile", &pyarpackSolver::dumpToFile, \ + "dump eigen vectors to arpackSolver.*.out files - default: false") \ + .def_readwrite("restartFromFile", &pyarpackSolver::restartFromFile, \ + "restart from eigen vectors found in arpackSolver.*.out files - default: false") \ + .def_readwrite("mag", &pyarpackSolver::mag, \ + "magnitude - default: LM") \ + .def_readwrite("maxIt", &pyarpackSolver::maxIt, \ + "maximum number of arpack iterations - default: 100") \ + .def_readwrite("schur", &pyarpackSolver::schur, \ + "compute schur vectors - default: false") \ + .def_readwrite("verbose", &pyarpackSolver::verbose, \ + "verbosity level - default: 0") \ + .def_readonly ("stdPb", &pyarpackSolver::stdPb, \ + "standard or generalised problem - default: true") \ + .def_readonly ("val", &pyarpackSolver::val, \ + "eigen values found") \ + .def_readonly ("vec", &pyarpackSolver::vec, \ + "eigen vectors found") \ + .def_readonly ("mode", &pyarpackSolver::mode, \ + "selected arpack mode (according to input options: std/gen, shift, ...)") \ + .def_readonly ("nbIt", &pyarpackSolver::nbIt, \ + "number of arpack iterations") \ + .def_readonly ("imsTime", &pyarpackSolver::imsTime, \ + "time spent to initialize the mode solver if needed") \ + .def_readonly ("rciTime", &pyarpackSolver::rciTime, \ + "time spent in Reverse Communication Interface") \ + .def_readwrite("debug", &pyarpackSolver::debug, \ + "debug traces (up to 3) - default: 0") \ + +#define ARPACKSOLVERDEBUGSTAT() \ +if (debug > 3) debug = 3; \ +debug_c(6, -6, debug, debug, debug, debug, debug, debug, debug, debug, debug, debug, debug, \ + debug, debug, debug, debug, debug, debug, debug, debug, debug, debug, debug); \ +stat_c(nopx, nbx, nrorth, nitref, nrstrt, tsaupd, tsaup2, \ + tsaitr, tseigt, tsgets, tsapps, tsconv, tnaupd, tnaup2, \ + tnaitr, tneigt, tngets, tnapps, tnconv, tcaupd, tcaup2, \ + tcaitr, tceigt, tcgets, tcapps, tcconv, tmvopx, tmvbx, \ + tgetv0, titref, trvec); \ + +void pyarpackThrowError(std::string const & msg) { + std::string const info = "Error: " + msg; + std::cerr << info << std::endl; + PyErr_SetString(PyExc_IndexError, info.c_str()); + bp::throw_error_already_set(); +}; + +template +class pyarpackServices { + // Public methods. + + public: + + static int buildSparseMatrice(bp::tuple const & T, Eigen::SparseMatrix & M, + a_int const & debug, std::string const & msg) { + // Get boost data as C++ data. + + if (bp::len(T) != 4) {pyarpackThrowError(msg + " must be a 3-tuple"); return 1;} + bp::extract nExt(T[0]); + bp::extract iExt(T[1]); + bp::extract jExt(T[2]); + bp::extract mijExt(T[3]); + if (! nExt.check()) {pyarpackThrowError(msg + "[0] must be an integer" ); return 1;} + if (! iExt.check()) {pyarpackThrowError(msg + "[1] must be numpy.array"); return 1;} + if (! jExt.check()) {pyarpackThrowError(msg + "[2] must be numpy.array"); return 1;} + if (!mijExt.check()) {pyarpackThrowError(msg + "[3] must be numpy.array"); return 1;} + bn::ndarray iArray = iExt(); + bn::ndarray jArray = jExt(); + bn::ndarray mijArray = mijExt(); + if (iArray.get_dtype() != bn::dtype::get_builtin()) {pyarpackThrowError(msg + "[1] type is not consistent"); return 1;} + if (jArray.get_dtype() != bn::dtype::get_builtin()) {pyarpackThrowError(msg + "[2] type is not consistent"); return 1;} + if (mijArray.get_dtype() != bn::dtype::get_builtin() ) {pyarpackThrowError(msg + "[3] type is not consistent with arpack type"); return 1;} + + a_int iSz = iArray.shape(0); + a_int * iPtr = reinterpret_cast(iArray.get_data()); + a_int jSz = jArray.shape(0); + a_int * jPtr = reinterpret_cast(jArray.get_data()); + a_int mSz = mijArray.shape(0); + RC * mPtr = reinterpret_cast(mijArray.get_data()); + + if (iSz != jSz) {pyarpackThrowError(msg + "[1] and " + msg + "[2] must have same lenght"); return 1;} + if (iSz != mSz) {pyarpackThrowError(msg + "[1] and " + msg + "[3] must have same lenght"); return 1;} + + // Debug on demand: casting value on numpy.append is MANDATORY or C++ won't get the expected type.. + + for (auto k = 0; debug && k < mSz; k++) { + std::cout << "pyarpackServices::buildSparseMatrice - " << msg << "[" << iPtr[k] << ", " << jPtr[k] << "] = " << mPtr[k] << std::endl; + }; + + // Build sparse matrice. + + a_uint n = nExt(); + a_uint iMin = n+1, jMin = n+1; + for (auto k = 0; k < mSz; k++) { + if (iPtr[k] < iMin) iMin = iPtr[k]; + if (jPtr[k] < jMin) jMin = jPtr[k]; + }; + if (iMin != 0 && iMin != 1) {pyarpackThrowError(msg + ": smallest row indice must be 0 or 1"); return 1;} + if (jMin != 0 && jMin != 1) {pyarpackThrowError(msg + ": smallest column indice must be 0 or 1"); return 1;} + a_int iBased = 0, jBased = 0; + if (iMin == 1) iBased = 1; + if (jMin == 1) jBased = 1; + + M = Eigen::SparseMatrix(n, n); // Set matrice dimensions. + std::vector> triplets; + a_uint nnz = mSz; + triplets.reserve(nnz); + for (auto k = 0; k < nnz; k++) triplets.emplace_back(iPtr[k] - iBased, jPtr[k] - jBased, mPtr[k]); + M.setFromTriplets(triplets.begin(), triplets.end()); // Set all (i, j, Mij). + + return 0; + }; + + static int buildDenseMatrice(bp::tuple const & T, Eigen::Matrix & M, + a_int const & debug, std::string const & msg) { + // Get boost data as C++ data. + + if (bp::len(T) != 2) {pyarpackThrowError(msg + " must be a 2-tuple"); return 1;} + bp::extract mijExt(T[0]); + bp::extract oExt(T[1]); + if (!mijExt.check()) {pyarpackThrowError(msg + " must be numpy.array"); return 1;} + if ( !oExt.check()) {pyarpackThrowError(msg + " must be a boolean"); return 1;} + bn::ndarray mijArray = mijExt(); + bool rowOrdered = oExt(); + if (mijArray.get_dtype() != bn::dtype::get_builtin()) {pyarpackThrowError(msg + " type is not consistent with arpack type"); return 1;} + + a_int mSz = mijArray.shape(0); + RC * mPtr = reinterpret_cast(mijArray.get_data()); + + a_uint n = std::sqrt(mSz); + if (n*n != mSz) {pyarpackThrowError(msg + " must be a squared matrice"); return 1;} + + // Debug on demand: casting value on numpy.append is MANDATORY or C++ won't get the expected type.. + + for (auto k = 0; debug && k < mSz; k++) { + std::cout << "pyarpackServices::buildDenseMatrice - " << msg << "[" << k << "] = " << mPtr[k] << std::endl; + }; + + // Build dense matrice. + + M = Eigen::Matrix(n, n); // Set matrice dimensions. + M.setZero(n, n); // Avoid spurious/random values which may break solves (LU, QR, ...). + if (rowOrdered) { + for (size_t k = 0; k < n; k++) { + for (size_t l = 0; l < n; l++) M(k, l) = mPtr[l+k*n]; + } + } + else { + for (size_t l = 0; l < n; l++) { + for (size_t k = 0; k < n; k++) M(k, l) = mPtr[k+l*n]; + } + } + + return 0; + }; +}; + +#endif + +// Local Variables: +// mode: c++ +// c-file-style:"stroustrup" +// show-trailing-whitespace: t +// End: +/* vim: set sw=2 ts=2 et smartindent :*/ diff -Nru arpack-3.7.0/EXAMPLES/PYARPACK/pyarpackSparseBiCGDiag.py.in arpack-3.8.0/EXAMPLES/PYARPACK/pyarpackSparseBiCGDiag.py.in --- arpack-3.7.0/EXAMPLES/PYARPACK/pyarpackSparseBiCGDiag.py.in 1970-01-01 00:00:00.000000000 +0000 +++ arpack-3.8.0/EXAMPLES/PYARPACK/pyarpackSparseBiCGDiag.py.in 2020-12-07 10:40:45.000000000 +0000 @@ -0,0 +1,118 @@ +#!/usr/bin/env python + +import numpy as np +from pyarpack import sparseBiCGDiag as pyarpackSlv + +# Build laplacian. + +n = 4 +i = np.array([], dtype='@PYINT@') +j = np.array([], dtype='@PYINT@') +Aij = np.array([], dtype='float64') +for k in range(n): + for l in [k-1, k, k+1]: + if l < 0 or l > n-1: + continue + i = np.append(i, np.@PYINT@(k)) # Casting value on append is MANDATORY or C++ won't get the expected type. + j = np.append(j, np.@PYINT@(l)) # Casting value on append is MANDATORY or C++ won't get the expected type. + if l == k: + Aij = np.append(Aij, np.float64( 200.)) # Casting value on append is MANDATORY or C++ won't get the expected type. + if l == k-1 or l == k+1: + Aij = np.append(Aij, np.float64(-100.)) # Casting value on append is MANDATORY or C++ won't get the expected type. +for k, l, Akl in zip(i, j, Aij): + print("A[", k, ",", l, "] =", Akl) +A = (n, i, j, Aij) # coo format: dimension, i 0-based indices, j 0-based indices, Aij values. + +# Get and tune arpack solver. + +arpackSlv = pyarpackSlv.double() # Caution: double <=> np.array(..., dtype='float64') +arpackSlv.verbose = 3 # Set to 0 to get a quiet solve. +arpackSlv.debug = 1 # Set to 0 to get a quiet solve. +arpackSlv.nbEV = 1 +arpackSlv.nbCV = 2*arpackSlv.nbEV + 1 +arpackSlv.mag = 'LM' +arpackSlv.maxIt = 200 +arpackSlv.slvTol = 1.e-6 +arpackSlv.slvMaxIt = 100 + +# Solve eigen problem. + +rc = arpackSlv.solve(A) +assert rc == 0, "bad solve" +rc = arpackSlv.checkEigVec(A) +assert rc == 0, "bad checkEigVec" + +# Print out results (mode selected, eigen vectors, eigen values, ...). + +assert arpackSlv.nbEV == len(arpackSlv.val), "bad result" +print("\nresults:\n") +print("mode selected:", arpackSlv.mode) +print("nb iterations:", arpackSlv.nbIt) +print("Reverse Communication Interface time:", arpackSlv.rciTime, "s") +for val, vec in zip(arpackSlv.val, arpackSlv.vec): + print("eigen value:", val) + print("eigen vector:") + print(vec) + +####################################################################################### +print("\n##########################################################################\n") +####################################################################################### + +# Build laplacian. + +n = 8 +i = np.array([], dtype='@PYINT@') +j = np.array([], dtype='@PYINT@') +Aij = np.array([], dtype='float32') +Bij = np.array([], dtype='float32') +for k in range(n): + for l in [k-1, k, k+1]: + if l < 0 or l > n-1: + continue + i = np.append(i, np.@PYINT@(k+1)) # Casting value on append is MANDATORY or C++ won't get the expected type. + j = np.append(j, np.@PYINT@(l+1)) # Casting value on append is MANDATORY or C++ won't get the expected type. + if l == k: + Aij = np.append(Aij, np.float32( 200.)) # Casting value on append is MANDATORY or C++ won't get the expected type. + Bij = np.append(Bij, np.float32( 33.3)) # Casting value on append is MANDATORY or C++ won't get the expected type. + if l == k-1 or l == k+1: + Aij = np.append(Aij, np.float32(-100.)) # Casting value on append is MANDATORY or C++ won't get the expected type. + Bij = np.append(Bij, np.float32( 16.6)) # Casting value on append is MANDATORY or C++ won't get the expected type. +for k, l, Akl in zip(i, j, Aij): + print("A[", k, ",", l, "] =", Akl) +for k, l, Bkl in zip(i, j, Bij): + print("B[", k, ",", l, "] =", Bkl) +A = (n, i, j, Aij) # coo format: dimension, i 1-based indices, j 1-based indices, Aij values. +B = (n, i, j, Bij) # coo format: dimension, i 1-based indices, j 1-based indices, Bij values. + +# Get and tune arpack solver. + +arpackSlv = pyarpackSlv.float() # Caution: float <=> np.array(..., dtype='float32') +arpackSlv.verbose = 3 # Set to 0 to get a quiet solve. +arpackSlv.debug = 1 # Set to 0 to get a quiet solve. +arpackSlv.nbEV = 2 +arpackSlv.nbCV = 2*arpackSlv.nbEV + 1 +arpackSlv.mag = 'LM' +arpackSlv.maxIt = 200 +arpackSlv.slvTol = 1.e-6 +arpackSlv.slvMaxIt = 100 +arpackSlv.sigmaReal = 1 + +# Solve eigen problem. + +rc = arpackSlv.solve(A, B) +assert rc == 0, "bad solve" +rc = arpackSlv.checkEigVec(A, B, 1.e-2) +assert rc == 0, "bad checkEigVec" + +# Print out results (mode selected, eigen vectors, eigen values, ...). + +assert arpackSlv.nbEV == len(arpackSlv.val), "bad result" +print("\nresults:\n") +print("mode selected:", arpackSlv.mode) +print("nb iterations:", arpackSlv.nbIt) +print("Reverse Communication Interface time:", arpackSlv.rciTime, "s") +for val, vec in zip(arpackSlv.val, arpackSlv.vec): + print("eigen value:", val) + print("eigen vector:") + for v in range(n): + print(vec[v]) diff -Nru arpack-3.7.0/EXAMPLES/PYARPACK/pyarpackSparseBiCGILU.py.in arpack-3.8.0/EXAMPLES/PYARPACK/pyarpackSparseBiCGILU.py.in --- arpack-3.7.0/EXAMPLES/PYARPACK/pyarpackSparseBiCGILU.py.in 1970-01-01 00:00:00.000000000 +0000 +++ arpack-3.8.0/EXAMPLES/PYARPACK/pyarpackSparseBiCGILU.py.in 2020-12-07 10:40:45.000000000 +0000 @@ -0,0 +1,130 @@ +#!/usr/bin/env python + +import numpy as np +from pyarpack import sparseBiCGILU as pyarpackSlv + +# Build laplacian. + +n = 4 +i = np.array([], dtype='@PYINT@') +j = np.array([], dtype='@PYINT@') +Aij = np.array([], dtype='complex128') +for k in range(n): + for l in [k-1, k, k+1]: + if l < 0 or l > n-1: + continue + i = np.append(i, np.@PYINT@(k)) # Casting value on append is MANDATORY or C++ won't get the expected type. + j = np.append(j, np.@PYINT@(l)) # Casting value on append is MANDATORY or C++ won't get the expected type. + if l == k: + Aij = np.append(Aij, np.complex128(np.complex( 200., 200.))) # Casting value on append is MANDATORY or C++ won't get the expected type. + if l == k-1: + Aij = np.append(Aij, np.complex128(np.complex(-101., -101.))) # Casting value on append is MANDATORY or C++ won't get the expected type. + if l == k+1: + Aij = np.append(Aij, np.complex128(np.complex( -99., -99.))) # Casting value on append is MANDATORY or C++ won't get the expected type. +for k, l, Akl in zip(i, j, Aij): + print("A[", k, ",", l, "] =", Akl) +A = (n, i, j, Aij) # coo format: dimension, i 0-based indices, j 0-based indices, Aij values. + +# Get and tune arpack solver. + +arpackSlv = pyarpackSlv.complexDouble() # Caution: complexDouble <=> np.array(..., dtype='complex128') +arpackSlv.verbose = 3 # Set to 0 to get a quiet solve. +arpackSlv.debug = 1 # Set to 0 to get a quiet solve. +arpackSlv.nbEV = 1 +arpackSlv.nbCV = 2*arpackSlv.nbEV + 1 +arpackSlv.mag = 'LM' +arpackSlv.maxIt = 200 +arpackSlv.slvTol = 1.e-6 +arpackSlv.slvMaxIt = 200 +arpackSlv.slvILUDropTol = 1. +arpackSlv.slvILUFillFactor = 2 +arpackSlv.symPb = False + +# Solve eigen problem. + +rc = arpackSlv.solve(A) +assert rc == 0, "bad solve" +rc = arpackSlv.checkEigVec(A) +assert rc == 0, "bad checkEigVec" + +# Print out results (mode selected, eigen vectors, eigen values, ...). + +assert arpackSlv.nbEV == len(arpackSlv.val), "bad result" +print("\nresults:\n") +print("mode selected:", arpackSlv.mode) +print("nb iterations:", arpackSlv.nbIt) +print("Reverse Communication Interface time:", arpackSlv.rciTime, "s") +for val, vec in zip(arpackSlv.val, arpackSlv.vec): + print("eigen value:", val) + print("eigen vector:") + print(vec) + +####################################################################################### +print("\n##########################################################################\n") +####################################################################################### + +# Build laplacian. + +n = 8 +i = np.array([], dtype='@PYINT@') +j = np.array([], dtype='@PYINT@') +Aij = np.array([], dtype='complex64') +Bij = np.array([], dtype='complex64') +for k in range(n): + for l in [k-1, k, k+1]: + if l < 0 or l > n-1: + continue + i = np.append(i, np.@PYINT@(k+1)) # Casting value on append is MANDATORY or C++ won't get the expected type. + j = np.append(j, np.@PYINT@(l+1)) # Casting value on append is MANDATORY or C++ won't get the expected type. + if l == k: + Aij = np.append(Aij, np.complex64(np.complex( 200., 200.))) # Casting value on append is MANDATORY or C++ won't get the expected type. + Bij = np.append(Bij, np.complex64(np.complex( 33.3, 33.3))) # Casting value on append is MANDATORY or C++ won't get the expected type. + if l == k-1: + Aij = np.append(Aij, np.complex64(np.complex(-101., -101.))) # Casting value on append is MANDATORY or C++ won't get the expected type. + Bij = np.append(Bij, np.complex64(np.complex( 16.6, 16.6))) # Casting value on append is MANDATORY or C++ won't get the expected type. + if l == k+1: + Aij = np.append(Aij, np.complex64(np.complex( -99., -99.))) # Casting value on append is MANDATORY or C++ won't get the expected type. + Bij = np.append(Bij, np.complex64(np.complex( 16.6, 16.6))) # Casting value on append is MANDATORY or C++ won't get the expected type. +for k, l, Akl in zip(i, j, Aij): + print("A[", k, ",", l, "] =", Akl) +for k, l, Bkl in zip(i, j, Bij): + print("B[", k, ",", l, "] =", Bkl) +A = (n, i, j, Aij) # coo format: dimension, i 1-based indices, j 1-based indices, Aij values. +B = (n, i, j, Bij) # coo format: dimension, i 1-based indices, j 1-based indices, Bij values. + +# Get and tune arpack solver. + +arpackSlv = pyarpackSlv.complexFloat() # Caution: complexFloat <=> np.array(..., dtype='complex64') +arpackSlv.verbose = 3 # Set to 0 to get a quiet solve. +arpackSlv.debug = 1 # Set to 0 to get a quiet solve. +arpackSlv.nbEV = 2 +arpackSlv.nbCV = 2*arpackSlv.nbEV + 1 +arpackSlv.mag = 'LM' +arpackSlv.maxIt = 200 +arpackSlv.slvTol = 1.e-6 +arpackSlv.slvMaxIt = 200 +arpackSlv.slvILUDropTol = 1. +arpackSlv.slvILUFillFactor = 2 +arpackSlv.sigmaReal = 1 +arpackSlv.sigmaImag = 1 +arpackSlv.symPb = False + +# Solve eigen problem. + +rc = arpackSlv.solve(A, B) +assert rc == 0, "bad solve" +rc = arpackSlv.checkEigVec(A, B, 1.e-2) +assert rc == 0, "bad checkEigVec" + +# Print out results (mode selected, eigen vectors, eigen values, ...). + +assert arpackSlv.nbEV == len(arpackSlv.val), "bad result" +print("\nresults:\n") +print("mode selected:", arpackSlv.mode) +print("nb iterations:", arpackSlv.nbIt) +print("Reverse Communication Interface time:", arpackSlv.rciTime, "s") +for val, vec in zip(arpackSlv.val, arpackSlv.vec): + print("eigen value:", val) + print("eigen vector:") + for v in range(n): + print(vec[v]) diff -Nru arpack-3.7.0/EXAMPLES/PYARPACK/pyarpackSparseCGDiag.py.in arpack-3.8.0/EXAMPLES/PYARPACK/pyarpackSparseCGDiag.py.in --- arpack-3.7.0/EXAMPLES/PYARPACK/pyarpackSparseCGDiag.py.in 1970-01-01 00:00:00.000000000 +0000 +++ arpack-3.8.0/EXAMPLES/PYARPACK/pyarpackSparseCGDiag.py.in 2020-12-07 10:40:45.000000000 +0000 @@ -0,0 +1,118 @@ +#!/usr/bin/env python + +import numpy as np +from pyarpack import sparseCGDiag as pyarpackSlv + +# Build laplacian. + +n = 4 +i = np.array([], dtype='@PYINT@') +j = np.array([], dtype='@PYINT@') +Aij = np.array([], dtype='float64') +for k in range(n): + for l in [k-1, k, k+1]: + if l < 0 or l > n-1: + continue + i = np.append(i, np.@PYINT@(k)) # Casting value on append is MANDATORY or C++ won't get the expected type. + j = np.append(j, np.@PYINT@(l)) # Casting value on append is MANDATORY or C++ won't get the expected type. + if l == k: + Aij = np.append(Aij, np.float64( 200.)) # Casting value on append is MANDATORY or C++ won't get the expected type. + if l == k-1 or l == k+1: + Aij = np.append(Aij, np.float64(-100.)) # Casting value on append is MANDATORY or C++ won't get the expected type. +for k, l, Akl in zip(i, j, Aij): + print("A[", k, ",", l, "] =", Akl) +A = (n, i, j, Aij) # coo format: dimension, i 0-based indices, j 0-based indices, Aij values. + +# Get and tune arpack solver. + +arpackSlv = pyarpackSlv.double() # Caution: double <=> np.array(..., dtype='float64') +arpackSlv.verbose = 3 # Set to 0 to get a quiet solve. +arpackSlv.debug = 1 # Set to 0 to get a quiet solve. +arpackSlv.nbEV = 1 +arpackSlv.nbCV = 2*arpackSlv.nbEV + 1 +arpackSlv.mag = 'LM' +arpackSlv.maxIt = 200 +arpackSlv.slvTol = 1.e-6 +arpackSlv.slvMaxIt = 100 + +# Solve eigen problem. + +rc = arpackSlv.solve(A) +assert rc == 0, "bad solve" +rc = arpackSlv.checkEigVec(A) +assert rc == 0, "bad checkEigVec" + +# Print out results (mode selected, eigen vectors, eigen values, ...). + +assert arpackSlv.nbEV == len(arpackSlv.val), "bad result" +print("\nresults:\n") +print("mode selected:", arpackSlv.mode) +print("nb iterations:", arpackSlv.nbIt) +print("Reverse Communication Interface time:", arpackSlv.rciTime, "s") +for val, vec in zip(arpackSlv.val, arpackSlv.vec): + print("eigen value:", val) + print("eigen vector:") + print(vec) + +####################################################################################### +print("\n##########################################################################\n") +####################################################################################### + +# Build laplacian. + +n = 8 +i = np.array([], dtype='@PYINT@') +j = np.array([], dtype='@PYINT@') +Aij = np.array([], dtype='float32') +Bij = np.array([], dtype='float32') +for k in range(n): + for l in [k-1, k, k+1]: + if l < 0 or l > n-1: + continue + i = np.append(i, np.@PYINT@(k+1)) # Casting value on append is MANDATORY or C++ won't get the expected type. + j = np.append(j, np.@PYINT@(l+1)) # Casting value on append is MANDATORY or C++ won't get the expected type. + if l == k: + Aij = np.append(Aij, np.float32( 200.)) # Casting value on append is MANDATORY or C++ won't get the expected type. + Bij = np.append(Bij, np.float32( 33.3)) # Casting value on append is MANDATORY or C++ won't get the expected type. + if l == k-1 or l == k+1: + Aij = np.append(Aij, np.float32(-100.)) # Casting value on append is MANDATORY or C++ won't get the expected type. + Bij = np.append(Bij, np.float32( 16.6)) # Casting value on append is MANDATORY or C++ won't get the expected type. +for k, l, Akl in zip(i, j, Aij): + print("A[", k, ",", l, "] =", Akl) +for k, l, Bkl in zip(i, j, Bij): + print("B[", k, ",", l, "] =", Bkl) +A = (n, i, j, Aij) # coo format: dimension, i 1-based indices, j 1-based indices, Aij values. +B = (n, i, j, Bij) # coo format: dimension, i 1-based indices, j 1-based indices, Bij values. + +# Get and tune arpack solver. + +arpackSlv = pyarpackSlv.float() # Caution: float <=> np.array(..., dtype='float32') +arpackSlv.verbose = 3 # Set to 0 to get a quiet solve. +arpackSlv.debug = 1 # Set to 0 to get a quiet solve. +arpackSlv.nbEV = 2 +arpackSlv.nbCV = 2*arpackSlv.nbEV + 1 +arpackSlv.mag = 'LM' +arpackSlv.maxIt = 200 +arpackSlv.slvTol = 1.e-6 +arpackSlv.slvMaxIt = 100 +arpackSlv.sigmaReal = 1 + +# Solve eigen problem. + +rc = arpackSlv.solve(A, B) +assert rc == 0, "bad solve" +rc = arpackSlv.checkEigVec(A, B, 1.e-2) +assert rc == 0, "bad checkEigVec" + +# Print out results (mode selected, eigen vectors, eigen values, ...). + +assert arpackSlv.nbEV == len(arpackSlv.val), "bad result" +print("\nresults:\n") +print("mode selected:", arpackSlv.mode) +print("nb iterations:", arpackSlv.nbIt) +print("Reverse Communication Interface time:", arpackSlv.rciTime, "s") +for val, vec in zip(arpackSlv.val, arpackSlv.vec): + print("eigen value:", val) + print("eigen vector:") + for v in range(n): + print(vec[v]) diff -Nru arpack-3.7.0/EXAMPLES/PYARPACK/pyarpackSparseCGILU.py.in arpack-3.8.0/EXAMPLES/PYARPACK/pyarpackSparseCGILU.py.in --- arpack-3.7.0/EXAMPLES/PYARPACK/pyarpackSparseCGILU.py.in 1970-01-01 00:00:00.000000000 +0000 +++ arpack-3.8.0/EXAMPLES/PYARPACK/pyarpackSparseCGILU.py.in 2020-12-07 10:40:45.000000000 +0000 @@ -0,0 +1,130 @@ +#!/usr/bin/env python + +import numpy as np +from pyarpack import sparseCGILU as pyarpackSlv + +# Build laplacian. + +n = 4 +i = np.array([], dtype='@PYINT@') +j = np.array([], dtype='@PYINT@') +Aij = np.array([], dtype='complex128') +for k in range(n): + for l in [k-1, k, k+1]: + if l < 0 or l > n-1: + continue + i = np.append(i, np.@PYINT@(k)) # Casting value on append is MANDATORY or C++ won't get the expected type. + j = np.append(j, np.@PYINT@(l)) # Casting value on append is MANDATORY or C++ won't get the expected type. + if l == k: + Aij = np.append(Aij, np.complex128(np.complex( 200., 200.))) # Casting value on append is MANDATORY or C++ won't get the expected type. + if l == k-1: + Aij = np.append(Aij, np.complex128(np.complex(-101., -101.))) # Casting value on append is MANDATORY or C++ won't get the expected type. + if l == k+1: + Aij = np.append(Aij, np.complex128(np.complex( -99., -99.))) # Casting value on append is MANDATORY or C++ won't get the expected type. +for k, l, Akl in zip(i, j, Aij): + print("A[", k, ",", l, "] =", Akl) +A = (n, i, j, Aij) # coo format: dimension, i 0-based indices, j 0-based indices, Aij values. + +# Get and tune arpack solver. + +arpackSlv = pyarpackSlv.complexDouble() # Caution: complexDouble <=> np.array(..., dtype='complex128') +arpackSlv.verbose = 3 # Set to 0 to get a quiet solve. +arpackSlv.debug = 1 # Set to 0 to get a quiet solve. +arpackSlv.nbEV = 1 +arpackSlv.nbCV = 2*arpackSlv.nbEV + 1 +arpackSlv.mag = 'LM' +arpackSlv.maxIt = 200 +arpackSlv.slvTol = 1.e-6 +arpackSlv.slvMaxIt = 200 +arpackSlv.slvILUDropTol = 1. +arpackSlv.slvILUFillFactor = 2 +arpackSlv.symPb = False + +# Solve eigen problem. + +rc = arpackSlv.solve(A) +assert rc == 0, "bad solve" +rc = arpackSlv.checkEigVec(A) +assert rc == 0, "bad checkEigVec" + +# Print out results (mode selected, eigen vectors, eigen values, ...). + +assert arpackSlv.nbEV == len(arpackSlv.val), "bad result" +print("\nresults:\n") +print("mode selected:", arpackSlv.mode) +print("nb iterations:", arpackSlv.nbIt) +print("Reverse Communication Interface time:", arpackSlv.rciTime, "s") +for val, vec in zip(arpackSlv.val, arpackSlv.vec): + print("eigen value:", val) + print("eigen vector:") + print(vec) + +####################################################################################### +print("\n##########################################################################\n") +####################################################################################### + +# Build laplacian. + +n = 8 +i = np.array([], dtype='@PYINT@') +j = np.array([], dtype='@PYINT@') +Aij = np.array([], dtype='complex64') +Bij = np.array([], dtype='complex64') +for k in range(n): + for l in [k-1, k, k+1]: + if l < 0 or l > n-1: + continue + i = np.append(i, np.@PYINT@(k+1)) # Casting value on append is MANDATORY or C++ won't get the expected type. + j = np.append(j, np.@PYINT@(l+1)) # Casting value on append is MANDATORY or C++ won't get the expected type. + if l == k: + Aij = np.append(Aij, np.complex64(np.complex( 200., 200.))) # Casting value on append is MANDATORY or C++ won't get the expected type. + Bij = np.append(Bij, np.complex64(np.complex( 33.3, 33.3))) # Casting value on append is MANDATORY or C++ won't get the expected type. + if l == k-1: + Aij = np.append(Aij, np.complex64(np.complex(-101., -101.))) # Casting value on append is MANDATORY or C++ won't get the expected type. + Bij = np.append(Bij, np.complex64(np.complex( 16.6, 16.6))) # Casting value on append is MANDATORY or C++ won't get the expected type. + if l == k+1: + Aij = np.append(Aij, np.complex64(np.complex( -99., -99.))) # Casting value on append is MANDATORY or C++ won't get the expected type. + Bij = np.append(Bij, np.complex64(np.complex( 16.6, 16.6))) # Casting value on append is MANDATORY or C++ won't get the expected type. +for k, l, Akl in zip(i, j, Aij): + print("A[", k, ",", l, "] =", Akl) +for k, l, Bkl in zip(i, j, Bij): + print("B[", k, ",", l, "] =", Bkl) +A = (n, i, j, Aij) # coo format: dimension, i 1-based indices, j 1-based indices, Aij values. +B = (n, i, j, Bij) # coo format: dimension, i 1-based indices, j 1-based indices, Bij values. + +# Get and tune arpack solver. + +arpackSlv = pyarpackSlv.complexFloat() # Caution: complexFloat <=> np.array(..., dtype='complex64') +arpackSlv.verbose = 3 # Set to 0 to get a quiet solve. +arpackSlv.debug = 1 # Set to 0 to get a quiet solve. +arpackSlv.nbEV = 2 +arpackSlv.nbCV = 2*arpackSlv.nbEV + 1 +arpackSlv.mag = 'LM' +arpackSlv.maxIt = 200 +arpackSlv.slvTol = 1.e-6 +arpackSlv.slvMaxIt = 200 +arpackSlv.slvILUDropTol = 1. +arpackSlv.slvILUFillFactor = 2 +arpackSlv.sigmaReal = 1 +arpackSlv.sigmaImag = 1 +arpackSlv.symPb = False + +# Solve eigen problem. + +rc = arpackSlv.solve(A, B) +assert rc == 0, "bad solve" +rc = arpackSlv.checkEigVec(A, B, 1.) +assert rc == 0, "bad checkEigVec" + +# Print out results (mode selected, eigen vectors, eigen values, ...). + +assert arpackSlv.nbEV == len(arpackSlv.val), "bad result" +print("\nresults:\n") +print("mode selected:", arpackSlv.mode) +print("nb iterations:", arpackSlv.nbIt) +print("Reverse Communication Interface time:", arpackSlv.rciTime, "s") +for val, vec in zip(arpackSlv.val, arpackSlv.vec): + print("eigen value:", val) + print("eigen vector:") + for v in range(n): + print(vec[v]) diff -Nru arpack-3.7.0/EXAMPLES/PYARPACK/pyarpackSparseLDLT.py.in arpack-3.8.0/EXAMPLES/PYARPACK/pyarpackSparseLDLT.py.in --- arpack-3.7.0/EXAMPLES/PYARPACK/pyarpackSparseLDLT.py.in 1970-01-01 00:00:00.000000000 +0000 +++ arpack-3.8.0/EXAMPLES/PYARPACK/pyarpackSparseLDLT.py.in 2020-12-07 10:40:45.000000000 +0000 @@ -0,0 +1,126 @@ +#!/usr/bin/env python + +import numpy as np +from pyarpack import sparseLDLT as pyarpackSlv + +# Build laplacian. + +n = 4 +i = np.array([], dtype='@PYINT@') +j = np.array([], dtype='@PYINT@') +Aij = np.array([], dtype='complex128') +for k in range(n): + for l in [k-1, k, k+1]: + if l < 0 or l > n-1: + continue + i = np.append(i, np.@PYINT@(k)) # Casting value on append is MANDATORY or C++ won't get the expected type. + j = np.append(j, np.@PYINT@(l)) # Casting value on append is MANDATORY or C++ won't get the expected type. + if l == k: + Aij = np.append(Aij, np.complex128(np.complex( 200., 200.))) # Casting value on append is MANDATORY or C++ won't get the expected type. + if l == k-1: + Aij = np.append(Aij, np.complex128(np.complex(-101., -101.))) # Casting value on append is MANDATORY or C++ won't get the expected type. + if l == k+1: + Aij = np.append(Aij, np.complex128(np.complex( -99., -99.))) # Casting value on append is MANDATORY or C++ won't get the expected type. +for k, l, Akl in zip(i, j, Aij): + print("A[", k, ",", l, "] =", Akl) +A = (n, i, j, Aij) # coo format: dimension, i 0-based indices, j 0-based indices, Aij values. + +# Get and tune arpack solver. + +arpackSlv = pyarpackSlv.complexDouble() # Caution: complexDouble <=> np.array(..., dtype='complex128') +arpackSlv.verbose = 3 # Set to 0 to get a quiet solve. +arpackSlv.debug = 1 # Set to 0 to get a quiet solve. +arpackSlv.nbEV = 1 +arpackSlv.nbCV = 2*arpackSlv.nbEV + 1 +arpackSlv.mag = 'LM' +arpackSlv.maxIt = 200 +arpackSlv.slvOffset = 0. +arpackSlv.slvScale = 1. +arpackSlv.symPb = False + +# Solve eigen problem. + +rc = arpackSlv.solve(A) +assert rc == 0, "bad solve" +rc = arpackSlv.checkEigVec(A) +assert rc == 0, "bad checkEigVec" + +# Print out results (mode selected, eigen vectors, eigen values, ...). + +assert arpackSlv.nbEV == len(arpackSlv.val), "bad result" +print("\nresults:\n") +print("mode selected:", arpackSlv.mode) +print("nb iterations:", arpackSlv.nbIt) +print("Reverse Communication Interface time:", arpackSlv.rciTime, "s") +for val, vec in zip(arpackSlv.val, arpackSlv.vec): + print("eigen value:", val) + print("eigen vector:") + print(vec) + +####################################################################################### +print("\n##########################################################################\n") +####################################################################################### + +# Build laplacian. + +n = 8 +i = np.array([], dtype='@PYINT@') +j = np.array([], dtype='@PYINT@') +Aij = np.array([], dtype='complex64') +Bij = np.array([], dtype='complex64') +for k in range(n): + for l in [k-1, k, k+1]: + if l < 0 or l > n-1: + continue + i = np.append(i, np.@PYINT@(k+1)) # Casting value on append is MANDATORY or C++ won't get the expected type. + j = np.append(j, np.@PYINT@(l+1)) # Casting value on append is MANDATORY or C++ won't get the expected type. + if l == k: + Aij = np.append(Aij, np.complex64(np.complex( 200., 200.))) # Casting value on append is MANDATORY or C++ won't get the expected type. + Bij = np.append(Bij, np.complex64(np.complex( 33.3, 33.3))) # Casting value on append is MANDATORY or C++ won't get the expected type. + if l == k-1: + Aij = np.append(Aij, np.complex64(np.complex(-101., -101.))) # Casting value on append is MANDATORY or C++ won't get the expected type. + Bij = np.append(Bij, np.complex64(np.complex( 16.6, 16.6))) # Casting value on append is MANDATORY or C++ won't get the expected type. + if l == k+1: + Aij = np.append(Aij, np.complex64(np.complex( -99., -99.))) # Casting value on append is MANDATORY or C++ won't get the expected type. + Bij = np.append(Bij, np.complex64(np.complex( 16.6, 16.6))) # Casting value on append is MANDATORY or C++ won't get the expected type. +for k, l, Akl in zip(i, j, Aij): + print("A[", k, ",", l, "] =", Akl) +for k, l, Bkl in zip(i, j, Bij): + print("B[", k, ",", l, "] =", Bkl) +A = (n, i, j, Aij) # coo format: dimension, i 1-based indices, j 1-based indices, Aij values. +B = (n, i, j, Bij) # coo format: dimension, i 1-based indices, j 1-based indices, Bij values. + +# Get and tune arpack solver. + +arpackSlv = pyarpackSlv.complexFloat() # Caution: complexFloat <=> np.array(..., dtype='complex64') +arpackSlv.verbose = 3 # Set to 0 to get a quiet solve. +arpackSlv.debug = 1 # Set to 0 to get a quiet solve. +arpackSlv.nbEV = 2 +arpackSlv.nbCV = 2*arpackSlv.nbEV + 1 +arpackSlv.mag = 'LM' +arpackSlv.maxIt = 200 +arpackSlv.slvOffset = 0. +arpackSlv.slvScale = 1. +arpackSlv.sigmaReal = 1 +arpackSlv.sigmaImag = 1 +arpackSlv.symPb = False + +# Solve eigen problem. + +rc = arpackSlv.solve(A, B) +assert rc == 0, "bad solve" +rc = arpackSlv.checkEigVec(A, B, 1.e-2) +assert rc == 0, "bad checkEigVec" + +# Print out results (mode selected, eigen vectors, eigen values, ...). + +assert arpackSlv.nbEV == len(arpackSlv.val), "bad result" +print("\nresults:\n") +print("mode selected:", arpackSlv.mode) +print("nb iterations:", arpackSlv.nbIt) +print("Reverse Communication Interface time:", arpackSlv.rciTime, "s") +for val, vec in zip(arpackSlv.val, arpackSlv.vec): + print("eigen value:", val) + print("eigen vector:") + for v in range(n): + print(vec[v]) diff -Nru arpack-3.7.0/EXAMPLES/PYARPACK/pyarpackSparseLLT.py.in arpack-3.8.0/EXAMPLES/PYARPACK/pyarpackSparseLLT.py.in --- arpack-3.7.0/EXAMPLES/PYARPACK/pyarpackSparseLLT.py.in 1970-01-01 00:00:00.000000000 +0000 +++ arpack-3.8.0/EXAMPLES/PYARPACK/pyarpackSparseLLT.py.in 2020-12-07 10:40:45.000000000 +0000 @@ -0,0 +1,117 @@ +#!/usr/bin/env python + +import numpy as np +from pyarpack import sparseLLT as pyarpackSlv + +# Build laplacian. + +n = 4 +i = np.array([], dtype='@PYINT@') +j = np.array([], dtype='@PYINT@') +Aij = np.array([], dtype='float64') +for k in range(n): + for l in [k-1, k, k+1]: + if l < 0 or l > n-1: + continue + i = np.append(i, np.@PYINT@(k)) # Casting value on append is MANDATORY or C++ won't get the expected type. + j = np.append(j, np.@PYINT@(l)) # Casting value on append is MANDATORY or C++ won't get the expected type. + if l == k: + Aij = np.append(Aij, np.float64( 200.)) # Casting value on append is MANDATORY or C++ won't get the expected type. + if l == k-1 or l == k+1: + Aij = np.append(Aij, np.float64(-100.)) # Casting value on append is MANDATORY or C++ won't get the expected type. +for k, l, Akl in zip(i, j, Aij): + print("A[", k, ",", l, "] =", Akl) +A = (n, i, j, Aij) # coo format: dimension, i 0-based indices, j 0-based indices, Aij values. + +# Get and tune arpack solver. + +arpackSlv = pyarpackSlv.double() # Caution: double <=> np.array(..., dtype='float64') +arpackSlv.verbose = 3 # Set to 0 to get a quiet solve. +arpackSlv.debug = 1 # Set to 0 to get a quiet solve. +arpackSlv.nbEV = 1 +arpackSlv.nbCV = 2*arpackSlv.nbEV + 1 +arpackSlv.mag = 'LM' +arpackSlv.maxIt = 200 +arpackSlv.slvOffset = 0. +arpackSlv.slvScale = 1. + +# Solve eigen problem. + +rc = arpackSlv.solve(A) +assert rc == 0, "bad solve" +rc = arpackSlv.checkEigVec(A) +assert rc == 0, "bad checkEigVec" + +# Print out results (mode selected, eigen vectors, eigen values, ...). + +assert arpackSlv.nbEV == len(arpackSlv.val), "bad result" +print("\nresults:\n") +print("mode selected:", arpackSlv.mode) +print("nb iterations:", arpackSlv.nbIt) +print("Reverse Communication Interface time:", arpackSlv.rciTime, "s") +for val, vec in zip(arpackSlv.val, arpackSlv.vec): + print("eigen value:", val) + print("eigen vector:") + print(vec) + +####################################################################################### +print("\n##########################################################################\n") +####################################################################################### + +# Build laplacian. + +n = 8 +i = np.array([], dtype='@PYINT@') +j = np.array([], dtype='@PYINT@') +Aij = np.array([], dtype='float32') +Bij = np.array([], dtype='float32') +for k in range(n): + for l in [k-1, k, k+1]: + if l < 0 or l > n-1: + continue + i = np.append(i, np.@PYINT@(k+1)) # Casting value on append is MANDATORY or C++ won't get the expected type. + j = np.append(j, np.@PYINT@(l+1)) # Casting value on append is MANDATORY or C++ won't get the expected type. + if l == k: + Aij = np.append(Aij, np.float32( 200.)) # Casting value on append is MANDATORY or C++ won't get the expected type. + Bij = np.append(Bij, np.float32( 33.3)) # Casting value on append is MANDATORY or C++ won't get the expected type. + if l == k-1 or l == k+1: + Aij = np.append(Aij, np.float32(-100.)) # Casting value on append is MANDATORY or C++ won't get the expected type. + Bij = np.append(Bij, np.float32( 16.6)) # Casting value on append is MANDATORY or C++ won't get the expected type. +for k, l, Akl in zip(i, j, Aij): + print("A[", k, ",", l, "] =", Akl) +for k, l, Bkl in zip(i, j, Bij): + print("B[", k, ",", l, "] =", Bkl) +A = (n, i, j, Aij) # coo format: dimension, i 1-based indices, j 1-based indices, Aij values. +B = (n, i, j, Bij) # coo format: dimension, i 1-based indices, j 1-based indices, Bij values. + +# Get and tune arpack solver. + +arpackSlv = pyarpackSlv.float() # Caution: float <=> np.array(..., dtype='float32') +arpackSlv.verbose = 3 # Set to 0 to get a quiet solve. +arpackSlv.debug = 1 # Set to 0 to get a quiet solve. +arpackSlv.nbEV = 2 +arpackSlv.nbCV = 2*arpackSlv.nbEV + 1 +arpackSlv.mag = 'LM' +arpackSlv.maxIt = 200 +arpackSlv.slvOffset = 0. +arpackSlv.slvScale = 1. + +# Solve eigen problem. + +rc = arpackSlv.solve(A, B) +assert rc == 0, "bad solve" +rc = arpackSlv.checkEigVec(A, B, 1.e-2) +assert rc == 0, "bad checkEigVec" + +# Print out results (mode selected, eigen vectors, eigen values, ...). + +assert arpackSlv.nbEV == len(arpackSlv.val), "bad result" +print("\nresults:\n") +print("mode selected:", arpackSlv.mode) +print("nb iterations:", arpackSlv.nbIt) +print("Reverse Communication Interface time:", arpackSlv.rciTime, "s") +for val, vec in zip(arpackSlv.val, arpackSlv.vec): + print("eigen value:", val) + print("eigen vector:") + for v in range(n): + print(vec[v]) diff -Nru arpack-3.7.0/EXAMPLES/PYARPACK/pyarpackSparseLU.py.in arpack-3.8.0/EXAMPLES/PYARPACK/pyarpackSparseLU.py.in --- arpack-3.7.0/EXAMPLES/PYARPACK/pyarpackSparseLU.py.in 1970-01-01 00:00:00.000000000 +0000 +++ arpack-3.8.0/EXAMPLES/PYARPACK/pyarpackSparseLU.py.in 2020-12-07 10:40:45.000000000 +0000 @@ -0,0 +1,116 @@ +#!/usr/bin/env python + +import numpy as np +from pyarpack import sparseLU as pyarpackSlv + +# Build laplacian. + +n = 4 +i = np.array([], dtype='@PYINT@') +j = np.array([], dtype='@PYINT@') +Aij = np.array([], dtype='float64') +for k in range(n): + for l in [k-1, k, k+1]: + if l < 0 or l > n-1: + continue + i = np.append(i, np.@PYINT@(k)) # Casting value on append is MANDATORY or C++ won't get the expected type. + j = np.append(j, np.@PYINT@(l)) # Casting value on append is MANDATORY or C++ won't get the expected type. + if l == k: + Aij = np.append(Aij, np.float64( 200.)) # Casting value on append is MANDATORY or C++ won't get the expected type. + if l == k-1 or l == k+1: + Aij = np.append(Aij, np.float64(-100.)) # Casting value on append is MANDATORY or C++ won't get the expected type. +for k, l, Akl in zip(i, j, Aij): + print("A[", k, ",", l, "] =", Akl) +A = (n, i, j, Aij) # coo format: dimension, i 0-based indices, j 0-based indices, Aij values. + +# Get and tune arpack solver. + +arpackSlv = pyarpackSlv.double() # Caution: double <=> np.array(..., dtype='float64') +arpackSlv.verbose = 3 # Set to 0 to get a quiet solve. +arpackSlv.debug = 1 # Set to 0 to get a quiet solve. +arpackSlv.nbEV = 1 +arpackSlv.nbCV = 2*arpackSlv.nbEV + 1 +arpackSlv.mag = 'LM' +arpackSlv.maxIt = 200 +arpackSlv.slvPvtThd = 1.e-6 + +# Solve eigen problem. + +rc = arpackSlv.solve(A) +assert rc == 0, "bad solve" +rc = arpackSlv.checkEigVec(A) +assert rc == 0, "bad checkEigVec" + +# Print out results (mode selected, eigen vectors, eigen values, ...). + +assert arpackSlv.nbEV == len(arpackSlv.val), "bad result" +print("\nresults:\n") +print("mode selected:", arpackSlv.mode) +print("nb iterations:", arpackSlv.nbIt) +print("Reverse Communication Interface time:", arpackSlv.rciTime, "s") +for val, vec in zip(arpackSlv.val, arpackSlv.vec): + print("eigen value:", val) + print("eigen vector:") + print(vec) + +####################################################################################### +print("\n##########################################################################\n") +####################################################################################### + +# Build laplacian. + +n = 8 +i = np.array([], dtype='@PYINT@') +j = np.array([], dtype='@PYINT@') +Aij = np.array([], dtype='float32') +Bij = np.array([], dtype='float32') +for k in range(n): + for l in [k-1, k, k+1]: + if l < 0 or l > n-1: + continue + i = np.append(i, np.@PYINT@(k+1)) # Casting value on append is MANDATORY or C++ won't get the expected type. + j = np.append(j, np.@PYINT@(l+1)) # Casting value on append is MANDATORY or C++ won't get the expected type. + if l == k: + Aij = np.append(Aij, np.float32( 200.)) # Casting value on append is MANDATORY or C++ won't get the expected type. + Bij = np.append(Bij, np.float32( 33.3)) # Casting value on append is MANDATORY or C++ won't get the expected type. + if l == k-1 or l == k+1: + Aij = np.append(Aij, np.float32(-100.)) # Casting value on append is MANDATORY or C++ won't get the expected type. + Bij = np.append(Bij, np.float32( 16.6)) # Casting value on append is MANDATORY or C++ won't get the expected type. +for k, l, Akl in zip(i, j, Aij): + print("A[", k, ",", l, "] =", Akl) +for k, l, Bkl in zip(i, j, Bij): + print("B[", k, ",", l, "] =", Bkl) +A = (n, i, j, Aij) # coo format: dimension, i 1-based indices, j 1-based indices, Aij values. +B = (n, i, j, Bij) # coo format: dimension, i 1-based indices, j 1-based indices, Bij values. + +# Get and tune arpack solver. + +arpackSlv = pyarpackSlv.float() # Caution: float <=> np.array(..., dtype='float32') +arpackSlv.verbose = 3 # Set to 0 to get a quiet solve. +arpackSlv.debug = 1 # Set to 0 to get a quiet solve. +arpackSlv.nbEV = 2 +arpackSlv.nbCV = 2*arpackSlv.nbEV + 1 +arpackSlv.mag = 'LM' +arpackSlv.maxIt = 200 +arpackSlv.slvPvtThd = 1.e-6 +arpackSlv.sigmaReal = 1 + +# Solve eigen problem. + +rc = arpackSlv.solve(A, B) +assert rc == 0, "bad solve" +rc = arpackSlv.checkEigVec(A, B, 1.e-2) +assert rc == 0, "bad checkEigVec" + +# Print out results (mode selected, eigen vectors, eigen values, ...). + +assert arpackSlv.nbEV == len(arpackSlv.val), "bad result" +print("\nresults:\n") +print("mode selected:", arpackSlv.mode) +print("nb iterations:", arpackSlv.nbIt) +print("Reverse Communication Interface time:", arpackSlv.rciTime, "s") +for val, vec in zip(arpackSlv.val, arpackSlv.vec): + print("eigen value:", val) + print("eigen vector:") + for v in range(n): + print(vec[v]) diff -Nru arpack-3.7.0/EXAMPLES/PYARPACK/pyarpackSparseQR.py.in arpack-3.8.0/EXAMPLES/PYARPACK/pyarpackSparseQR.py.in --- arpack-3.7.0/EXAMPLES/PYARPACK/pyarpackSparseQR.py.in 1970-01-01 00:00:00.000000000 +0000 +++ arpack-3.8.0/EXAMPLES/PYARPACK/pyarpackSparseQR.py.in 2020-12-07 10:40:45.000000000 +0000 @@ -0,0 +1,124 @@ +#!/usr/bin/env python + +import numpy as np +from pyarpack import sparseQR as pyarpackSlv + +# Build laplacian. + +n = 4 +i = np.array([], dtype='@PYINT@') +j = np.array([], dtype='@PYINT@') +Aij = np.array([], dtype='complex128') +for k in range(n): + for l in [k-1, k, k+1]: + if l < 0 or l > n-1: + continue + i = np.append(i, np.@PYINT@(k)) # Casting value on append is MANDATORY or C++ won't get the expected type. + j = np.append(j, np.@PYINT@(l)) # Casting value on append is MANDATORY or C++ won't get the expected type. + if l == k: + Aij = np.append(Aij, np.complex128(np.complex( 200., 200.))) # Casting value on append is MANDATORY or C++ won't get the expected type. + if l == k-1: + Aij = np.append(Aij, np.complex128(np.complex(-101., -101.))) # Casting value on append is MANDATORY or C++ won't get the expected type. + if l == k+1: + Aij = np.append(Aij, np.complex128(np.complex( -99., -99.))) # Casting value on append is MANDATORY or C++ won't get the expected type. +for k, l, Akl in zip(i, j, Aij): + print("A[", k, ",", l, "] =", Akl) +A = (n, i, j, Aij) # coo format: dimension, i 0-based indices, j 0-based indices, Aij values. + +# Get and tune arpack solver. + +arpackSlv = pyarpackSlv.complexDouble() # Caution: complexDouble <=> np.array(..., dtype='complex128') +arpackSlv.verbose = 3 # Set to 0 to get a quiet solve. +arpackSlv.debug = 1 # Set to 0 to get a quiet solve. +arpackSlv.nbEV = 1 +arpackSlv.nbCV = 2*arpackSlv.nbEV + 1 +arpackSlv.mag = 'LM' +arpackSlv.maxIt = 200 +arpackSlv.slvPvtThd = 1.e-6 +arpackSlv.symPb = False + +# Solve eigen problem. + +rc = arpackSlv.solve(A) +assert rc == 0, "bad solve" +rc = arpackSlv.checkEigVec(A) +assert rc == 0, "bad checkEigVec" + +# Print out results (mode selected, eigen vectors, eigen values, ...). + +assert arpackSlv.nbEV == len(arpackSlv.val), "bad result" +print("\nresults:\n") +print("mode selected:", arpackSlv.mode) +print("nb iterations:", arpackSlv.nbIt) +print("Reverse Communication Interface time:", arpackSlv.rciTime, "s") +for val, vec in zip(arpackSlv.val, arpackSlv.vec): + print("eigen value:", val) + print("eigen vector:") + print(vec) + +####################################################################################### +print("\n##########################################################################\n") +####################################################################################### + +# Build laplacian. + +n = 8 +i = np.array([], dtype='@PYINT@') +j = np.array([], dtype='@PYINT@') +Aij = np.array([], dtype='complex64') +Bij = np.array([], dtype='complex64') +for k in range(n): + for l in [k-1, k, k+1]: + if l < 0 or l > n-1: + continue + i = np.append(i, np.@PYINT@(k+1)) # Casting value on append is MANDATORY or C++ won't get the expected type. + j = np.append(j, np.@PYINT@(l+1)) # Casting value on append is MANDATORY or C++ won't get the expected type. + if l == k: + Aij = np.append(Aij, np.complex64(np.complex( 200., 200.))) # Casting value on append is MANDATORY or C++ won't get the expected type. + Bij = np.append(Bij, np.complex64(np.complex( 33.3, 33.3))) # Casting value on append is MANDATORY or C++ won't get the expected type. + if l == k-1: + Aij = np.append(Aij, np.complex64(np.complex(-101., -101.))) # Casting value on append is MANDATORY or C++ won't get the expected type. + Bij = np.append(Bij, np.complex64(np.complex( 16.6, 16.6))) # Casting value on append is MANDATORY or C++ won't get the expected type. + if l == k+1: + Aij = np.append(Aij, np.complex64(np.complex( -99., -99.))) # Casting value on append is MANDATORY or C++ won't get the expected type. + Bij = np.append(Bij, np.complex64(np.complex( 16.6, 16.6))) # Casting value on append is MANDATORY or C++ won't get the expected type. +for k, l, Akl in zip(i, j, Aij): + print("A[", k, ",", l, "] =", Akl) +for k, l, Bkl in zip(i, j, Bij): + print("B[", k, ",", l, "] =", Bkl) +A = (n, i, j, Aij) # coo format: dimension, i 1-based indices, j 1-based indices, Aij values. +B = (n, i, j, Bij) # coo format: dimension, i 1-based indices, j 1-based indices, Bij values. + +# Get and tune arpack solver. + +arpackSlv = pyarpackSlv.complexFloat() # Caution: complexFloat <=> np.array(..., dtype='complex64') +arpackSlv.verbose = 3 # Set to 0 to get a quiet solve. +arpackSlv.debug = 1 # Set to 0 to get a quiet solve. +arpackSlv.nbEV = 2 +arpackSlv.nbCV = 2*arpackSlv.nbEV + 1 +arpackSlv.mag = 'LM' +arpackSlv.maxIt = 200 +arpackSlv.slvPvtThd = 1.e-6 +arpackSlv.sigmaReal = 1 +arpackSlv.sigmaImag = 1 +arpackSlv.symPb = False + +# Solve eigen problem. + +rc = arpackSlv.solve(A, B) +assert rc == 0, "bad solve" +rc = arpackSlv.checkEigVec(A, B, 1.e-2) +assert rc == 0, "bad checkEigVec" + +# Print out results (mode selected, eigen vectors, eigen values, ...). + +assert arpackSlv.nbEV == len(arpackSlv.val), "bad result" +print("\nresults:\n") +print("mode selected:", arpackSlv.mode) +print("nb iterations:", arpackSlv.nbIt) +print("Reverse Communication Interface time:", arpackSlv.rciTime, "s") +for val, vec in zip(arpackSlv.val, arpackSlv.vec): + print("eigen value:", val) + print("eigen vector:") + for v in range(n): + print(vec[v]) diff -Nru arpack-3.7.0/EXAMPLES/PYARPACK/README arpack-3.8.0/EXAMPLES/PYARPACK/README --- arpack-3.7.0/EXAMPLES/PYARPACK/README 1970-01-01 00:00:00.000000000 +0000 +++ arpack-3.8.0/EXAMPLES/PYARPACK/README 2020-12-07 10:40:45.000000000 +0000 @@ -0,0 +1,66 @@ +pyarpack: python binding based on Boost.Python.Numpy used to expose arpack C++ API + +Installation: +------------- + +Python3: ~/arpack-ng/build> cmake -DCMAKE_INSTALL_PREFIX=/tmp/local -DPYTHON3=ON -DBOOST_PYTHON_LIBSUFFIX="3" .. + ~/arpack-ng/build> make all test +Note: Boost must have been compiled for Python3. + +Usage: +------ + +>> export PYTHONPATH="/tmp/local/lib/pyarpack:${PYTHONPATH}" +>> python +>> import pyarpack +>> help(pyarpack) + +You can use sparse or dense matrices, and, play with iterative or direct mode solvers (CG, LU, ...): + +1. choose arpack solver with a given mode solver + 1.1. if you need to handle sparse matrices + >> from pyarpack import sparseBiCG as pyarpackSlv + 1.2. if you need to handle dense matrices + >> from pyarpack import denseBiCG as pyarpackSlv +2. choose arpack data type (float, double, ...) + >> arpackSlv = pyarpackSlv.double() +3. solve the eigen problem + >> arpackSlv.solve(A, B) +4. get eigen values and vectors + >> print(arpackSlv.vec) + >> print(arpackSlv.val) + +You can also: + +1. restart a solve from the workspace of a previous solve: check out pyarpackRestart.py.in. +2. compute eigen and / or schur vectors. + +Note: + +1. arpack data type (float, double, ...) must be consistent with A/B numpy dtypes (float32, float64, ...). + at python side, the data MUST be casted in the EXACT expected type (int32, int64, float, double, ...). + otherwise, C++ may not get the data the way it expects them: C++ will not know how to read python data. + if you are not sure how data have been passed from python to C++, set arpackSlv.debug = 1 and check out debug traces. + in other words, pyarpack users MUST : + 1.1. create numpy arrays specifying explicitly the type: + >> Aij = np.array([], dtype='complex128') + 1.2. filling numpy arrays casting value on append: + >> Aij = np.append(Aij, np.complex128(np.complex( 200., 200.))) # Casting value on append is MANDATORY or C++ won't get the expected type. + 1.3. calling the solver flavor which is consistent with the numpy array data type: + >> arpackSlv = pyarpackSlv.complexDouble() # Caution: complexDouble <=> np.array(..., dtype='complex128') + note: NO data type check can be done at C++ side, the pyarpack user MUST insure data consistency. +2. sparse matrices must be provided in coo format (n, i, j, Mij), that is, as a tuple where: + 2.1. n is an integer. + 2.2. i, j, Mij are 1 x nnz numpy arrays. +3. dense matrices must be provided in raw format (Mij, rowOrdered), that is, as a tuple where: + 3.1. Mij is an n x n numpy array. + 3.2. rowOrdered is a boolean (column ordered if False). +4. arpack mode solver are provided by eigen: + 4.1. when solver is iterative, A and B can be sparse only. + 4.2. when solver is direct, A and B can be sparse or dense. + +Examples: +--------- + +~/arpack-ng> find . -name *.py.in (template files from which python scripts will result) + diff -Nru arpack-3.7.0/EXAMPLES/README.CALLING-ARPACK-FROM-C-OR-CPP arpack-3.8.0/EXAMPLES/README.CALLING-ARPACK-FROM-C-OR-CPP --- arpack-3.7.0/EXAMPLES/README.CALLING-ARPACK-FROM-C-OR-CPP 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/EXAMPLES/README.CALLING-ARPACK-FROM-C-OR-CPP 2020-12-07 10:40:45.000000000 +0000 @@ -1,2 +1,4 @@ -In ../TESTS, the file icb_arpack_c.c is an example of how to call arpack from C. -In ../TESTS, the file icb_arpack_cpp.cpp is an example of how to call arpack from C++. +In../ TESTS, + the file icb_arpack_c.c is an example of how to call arpack from C.In../ + TESTS, + the file icb_arpack_cpp.cpp is an example of how to call arpack from C++. diff -Nru arpack-3.7.0/.gitignore arpack-3.8.0/.gitignore --- arpack-3.7.0/.gitignore 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/.gitignore 2020-12-07 10:40:45.000000000 +0000 @@ -16,7 +16,12 @@ libtool .deps/ arpack.pc +parpack.pc +arpackSolver.pc arpackdef.h +arpackicb.h +arpack-ng-config.cmake +arpack-ng-config-version.cmake # Generated by `make` .dirstamp @@ -53,8 +58,8 @@ EXAMPLES/SVD/[sd]svd EXAMPLES/SYM/[sd]sdrv[123456] EXAMPLES/MATRIX_MARKET/arpackmm -EXAMPLES/MATRIX_MARKET/resid.out -EXAMPLES/MATRIX_MARKET/v.out +EXAMPLES/MATRIX_MARKET/arpackSolver.resid.out +EXAMPLES/MATRIX_MARKET/arpackSolver.v.out PARPACK/EXAMPLES/MPI/p[sd]ndrv[13] PARPACK/EXAMPLES/MPI/p[sd]sdrv1 PARPACK/EXAMPLES/MPI/p[cz]ndrv1 @@ -71,3 +76,7 @@ *.suo VISUAL_STUDIO/Release MKL/ VISUAL_STUDIO/bin/ + +# Temporary files +*~ +\#*# diff -Nru arpack-3.7.0/ICB/arpack.h arpack-3.8.0/ICB/arpack.h --- arpack-3.7.0/ICB/arpack.h 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/ICB/arpack.h 2020-12-07 10:40:45.000000000 +0000 @@ -8,17 +8,17 @@ #endif void cnaupd_c(a_int* ido, char const* bmat, a_int n, char const* which, a_int nev, float tol, float _Complex* resid, a_int ncv, float _Complex* v, a_int ldv, a_int* iparam, a_int* ipntr, float _Complex* workd, float _Complex* workl, a_int lworkl, float* rwork, a_int* info); -void cneupd_c(bool rvec, char const* howmny, a_int const* select, float _Complex* d, float _Complex* z, a_int ldz, float _Complex sigma, float _Complex* workev, char const* bmat, a_int n, char const* which, a_int nev, float tol, float _Complex* resid, a_int ncv, float _Complex* v, a_int ldv, a_int* iparam, a_int* ipntr, float _Complex* workd, float _Complex* workl, a_int lworkl, float* rwork, a_int* info); +void cneupd_c(a_int rvec, char const* howmny, a_int const* select, float _Complex* d, float _Complex* z, a_int ldz, float _Complex sigma, float _Complex* workev, char const* bmat, a_int n, char const* which, a_int nev, float tol, float _Complex* resid, a_int ncv, float _Complex* v, a_int ldv, a_int* iparam, a_int* ipntr, float _Complex* workd, float _Complex* workl, a_int lworkl, float* rwork, a_int* info); void dnaupd_c(a_int* ido, char const* bmat, a_int n, char const* which, a_int nev, double tol, double* resid, a_int ncv, double* v, a_int ldv, a_int* iparam, a_int* ipntr, double* workd, double* workl, a_int lworkl, a_int* info); -void dneupd_c(bool rvec, char const* howmny, a_int const* select, double* dr, double* di, double* z, a_int ldz, double sigmar, double sigmai, double * workev, char const* bmat, a_int n, char const* which, a_int nev, double tol, double* resid, a_int ncv, double* v, a_int ldv, a_int* iparam, a_int* ipntr, double* workd, double* workl, a_int lworkl, a_int* info); +void dneupd_c(a_int rvec, char const* howmny, a_int const* select, double* dr, double* di, double* z, a_int ldz, double sigmar, double sigmai, double * workev, char const* bmat, a_int n, char const* which, a_int nev, double tol, double* resid, a_int ncv, double* v, a_int ldv, a_int* iparam, a_int* ipntr, double* workd, double* workl, a_int lworkl, a_int* info); void dsaupd_c(a_int* ido, char const* bmat, a_int n, char const* which, a_int nev, double tol, double* resid, a_int ncv, double* v, a_int ldv, a_int* iparam, a_int* ipntr, double* workd, double* workl, a_int lworkl, a_int* info); -void dseupd_c(bool rvec, char const* howmny, a_int const* select, double* d, double* z, a_int ldz, double sigma, char const* bmat, a_int n, char const* which, a_int nev, double tol, double* resid, a_int ncv, double* v, a_int ldv, a_int* iparam, a_int* ipntr, double* workd, double* workl, a_int lworkl, a_int* info); +void dseupd_c(a_int rvec, char const* howmny, a_int const* select, double* d, double* z, a_int ldz, double sigma, char const* bmat, a_int n, char const* which, a_int nev, double tol, double* resid, a_int ncv, double* v, a_int ldv, a_int* iparam, a_int* ipntr, double* workd, double* workl, a_int lworkl, a_int* info); void snaupd_c(a_int* ido, char const* bmat, a_int n, char const* which, a_int nev, float tol, float* resid, a_int ncv, float* v, a_int ldv, a_int* iparam, a_int* ipntr, float* workd, float* workl, a_int lworkl, a_int* info); -void sneupd_c(bool rvec, char const* howmny, a_int const* select, float* dr, float* di, float* z, a_int ldz, float sigmar, float sigmai, float * workev, char const* bmat, a_int n, char const* which, a_int nev, float tol, float* resid, a_int ncv, float* v, a_int ldv, a_int* iparam, a_int* ipntr, float* workd, float* workl, a_int lworkl, a_int* info); +void sneupd_c(a_int rvec, char const* howmny, a_int const* select, float* dr, float* di, float* z, a_int ldz, float sigmar, float sigmai, float * workev, char const* bmat, a_int n, char const* which, a_int nev, float tol, float* resid, a_int ncv, float* v, a_int ldv, a_int* iparam, a_int* ipntr, float* workd, float* workl, a_int lworkl, a_int* info); void ssaupd_c(a_int* ido, char const* bmat, a_int n, char const* which, a_int nev, float tol, float* resid, a_int ncv, float* v, a_int ldv, a_int* iparam, a_int* ipntr, float* workd, float* workl, a_int lworkl, a_int* info); -void sseupd_c(bool rvec, char const* howmny, a_int const* select, float* d, float* z, a_int ldz, float sigma, char const* bmat, a_int n, char const* which, a_int nev, float tol, float* resid, a_int ncv, float* v, a_int ldv, a_int* iparam, a_int* ipntr, float* workd, float* workl, a_int lworkl, a_int* info); +void sseupd_c(a_int rvec, char const* howmny, a_int const* select, float* d, float* z, a_int ldz, float sigma, char const* bmat, a_int n, char const* which, a_int nev, float tol, float* resid, a_int ncv, float* v, a_int ldv, a_int* iparam, a_int* ipntr, float* workd, float* workl, a_int lworkl, a_int* info); void znaupd_c(a_int* ido, char const* bmat, a_int n, char const* which, a_int nev, double tol, double _Complex* resid, a_int ncv, double _Complex* v, a_int ldv, a_int* iparam, a_int* ipntr, double _Complex* workd, double _Complex* workl, a_int lworkl, double* rwork, a_int* info); -void zneupd_c(bool rvec, char const* howmny, a_int const* select, double _Complex* d, double _Complex* z, a_int ldz, double _Complex sigma, double _Complex* workev, char const* bmat, a_int n, char const* which, a_int nev, double tol, double _Complex* resid, a_int ncv, double _Complex* v, a_int ldv, a_int* iparam, a_int* ipntr, double _Complex* workd, double _Complex* workl, a_int lworkl, double* rwork, a_int* info); +void zneupd_c(a_int rvec, char const* howmny, a_int const* select, double _Complex* d, double _Complex* z, a_int ldz, double _Complex sigma, double _Complex* workev, char const* bmat, a_int n, char const* which, a_int nev, double tol, double _Complex* resid, a_int ncv, double _Complex* v, a_int ldv, a_int* iparam, a_int* ipntr, double _Complex* workd, double _Complex* workl, a_int lworkl, double* rwork, a_int* info); #ifdef __cplusplus } diff -Nru arpack-3.7.0/ICB/arpack.hpp arpack-3.8.0/ICB/arpack.hpp --- arpack-3.7.0/ICB/arpack.hpp 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/ICB/arpack.hpp 2020-12-07 10:40:45.000000000 +0000 @@ -69,7 +69,7 @@ } inline char const* convert_to_char(bmat const option) { - return option == bmat::identity ? "I" : "B"; + return option == bmat::identity ? "I" : "G"; } inline char const* convert_to_char(howmny const option) { @@ -100,7 +100,7 @@ ncv, v, ldv, iparam, ipntr, workd, workl, lworkl, &info); } -inline void seupd(bool rvec, howmny const howmny_option, a_int* select, float* d, +inline void seupd(a_int rvec, howmny const howmny_option, a_int* select, float* d, float* z, a_int ldz, float sigma, bmat const bmat_option, a_int n, which const ritz_option, a_int nev, float tol, float* resid, a_int ncv, float* v, a_int ldv, a_int* iparam, a_int* ipntr, @@ -120,7 +120,7 @@ ncv, v, ldv, iparam, ipntr, workd, workl, lworkl, &info); } -inline void seupd(bool rvec, howmny const howmny_option, a_int* select, double* d, +inline void seupd(a_int rvec, howmny const howmny_option, a_int* select, double* d, double* z, a_int ldz, double sigma, bmat const bmat_option, a_int n, which const ritz_option, a_int nev, double tol, double* resid, a_int ncv, double* v, a_int ldv, a_int* iparam, @@ -141,7 +141,7 @@ ncv, v, ldv, iparam, ipntr, workd, workl, lworkl, &info); } -inline void neupd(bool rvec, howmny const howmny_option, a_int* select, float* dr, +inline void neupd(a_int rvec, howmny const howmny_option, a_int* select, float* dr, float* di, float* z, a_int ldz, float sigmar, float sigmai, float * workev, bmat const bmat_option, a_int n, which const ritz_option, @@ -164,7 +164,7 @@ ncv, v, ldv, iparam, ipntr, workd, workl, lworkl, &info); } -inline void neupd(bool rvec, howmny const howmny_option, a_int* select, +inline void neupd(a_int rvec, howmny const howmny_option, a_int* select, double* dr, double* di, double* z, a_int ldz, double sigmar, double sigmai, double * workev, bmat const bmat_option, a_int n, @@ -193,7 +193,7 @@ rwork, &info); } -inline void neupd(bool rvec, howmny const howmny_option, a_int* select, +inline void neupd(a_int rvec, howmny const howmny_option, a_int* select, std::complex* d, std::complex* z, a_int ldz, std::complex sigma, std::complex* workev, bmat const bmat_option, a_int n, which const ritz_option, @@ -201,10 +201,11 @@ std::complex* v, a_int ldv, a_int* iparam, a_int* ipntr, std::complex* workd, std::complex* workl, a_int lworkl, float* rwork, a_int& info) { + std::complex sigma2 = sigma; internal::cneupd_c(rvec, internal::convert_to_char(howmny_option), select, reinterpret_cast<_Complex float*>(d), reinterpret_cast<_Complex float*>(z), ldz, - std::real(sigma) + std::imag(sigma) * I, + *reinterpret_cast<_Complex float*>(&sigma2), reinterpret_cast<_Complex float*>(workev), internal::convert_to_char(bmat_option), n, internal::convert_to_char(ritz_option), nev, tol, @@ -230,7 +231,7 @@ rwork, &info); } -inline void neupd(bool rvec, howmny const howmny_option, a_int* select, +inline void neupd(a_int rvec, howmny const howmny_option, a_int* select, std::complex* d, std::complex* z, a_int ldz, std::complex sigma, std::complex* workev, bmat const bmat_option, a_int n, which const ritz_option, @@ -238,10 +239,11 @@ std::complex* v, a_int ldv, a_int* iparam, a_int* ipntr, std::complex* workd, std::complex* workl, a_int lworkl, double* rwork, a_int& info) { + std::complex sigma2 = sigma; internal::zneupd_c(rvec, internal::convert_to_char(howmny_option), select, reinterpret_cast<_Complex double*>(d), reinterpret_cast<_Complex double*>(z), ldz, - std::real(sigma) + _Complex_I * std::imag(sigma), + *reinterpret_cast<_Complex double*>(&sigma2), reinterpret_cast<_Complex double*>(workev), internal::convert_to_char(bmat_option), n, internal::convert_to_char(ritz_option), nev, tol, diff -Nru arpack-3.7.0/ICB/debug_c.h arpack-3.8.0/ICB/debug_c.h --- arpack-3.7.0/ICB/debug_c.h 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/ICB/debug_c.h 2020-12-07 10:40:45.000000000 +0000 @@ -1,9 +1,11 @@ #ifndef __DEBUG_C_H__ #define __DEBUG_C_H__ -extern void debug_c(int logfil_c, int ndigit_c, int mgetv0_c, - int msaupd_c, int msaup2_c, int msaitr_c, int mseigt_c, int msapps_c, int msgets_c, int mseupd_c, - int mnaupd_c, int mnaup2_c, int mnaitr_c, int mneigh_c, int mnapps_c, int mngets_c, int mneupd_c, - int mcaupd_c, int mcaup2_c, int mcaitr_c, int mceigh_c, int mcapps_c, int mcgets_c, int mceupd_c); +#include "arpackdef.h" + +extern void debug_c(a_int logfil_c, a_int ndigit_c, a_int mgetv0_c, + a_int msaupd_c, a_int msaup2_c, a_int msaitr_c, a_int mseigt_c, a_int msapps_c, a_int msgets_c, a_int mseupd_c, + a_int mnaupd_c, a_int mnaup2_c, a_int mnaitr_c, a_int mneigh_c, a_int mnapps_c, a_int mngets_c, a_int mneupd_c, + a_int mcaupd_c, a_int mcaup2_c, a_int mcaitr_c, a_int mceigh_c, a_int mcapps_c, a_int mcgets_c, a_int mceupd_c); #endif diff -Nru arpack-3.7.0/ICB/debug_c.hpp arpack-3.8.0/ICB/debug_c.hpp --- arpack-3.7.0/ICB/debug_c.hpp 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/ICB/debug_c.hpp 2020-12-07 10:40:45.000000000 +0000 @@ -1,9 +1,11 @@ #ifndef __DEBUG_C_HPP__ #define __DEBUG_C_HPP__ -extern "C" void debug_c(int logfil_c, int ndigit_c, int mgetv0_c, - int msaupd_c, int msaup2_c, int msaitr_c, int mseigt_c, int msapps_c, int msgets_c, int mseupd_c, - int mnaupd_c, int mnaup2_c, int mnaitr_c, int mneigh_c, int mnapps_c, int mngets_c, int mneupd_c, - int mcaupd_c, int mcaup2_c, int mcaitr_c, int mceigh_c, int mcapps_c, int mcgets_c, int mceupd_c); +#include "arpackdef.h" + +extern "C" void debug_c(a_int logfil_c, a_int ndigit_c, a_int mgetv0_c, + a_int msaupd_c, a_int msaup2_c, a_int msaitr_c, a_int mseigt_c, a_int msapps_c, a_int msgets_c, a_int mseupd_c, + a_int mnaupd_c, a_int mnaup2_c, a_int mnaitr_c, a_int mneigh_c, a_int mnapps_c, a_int mngets_c, a_int mneupd_c, + a_int mcaupd_c, a_int mcaup2_c, a_int mcaitr_c, a_int mceigh_c, a_int mcapps_c, a_int mcgets_c, a_int mceupd_c); #endif diff -Nru arpack-3.7.0/ICB/debug_icb.F90 arpack-3.8.0/ICB/debug_icb.F90 --- arpack-3.7.0/ICB/debug_icb.F90 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/ICB/debug_icb.F90 2020-12-07 10:40:45.000000000 +0000 @@ -7,11 +7,11 @@ bind(c, name="debug_c") use :: iso_c_binding implicit none -#include "arpackdef.h" - integer(kind=c_int), value, intent(in) :: logfil_c, ndigit_c, mgetv0_c - integer(kind=c_int), value, intent(in) :: msaupd_c, msaup2_c, msaitr_c, mseigt_c, msapps_c, msgets_c, mseupd_c - integer(kind=c_int), value, intent(in) :: mnaupd_c, mnaup2_c, mnaitr_c, mneigh_c, mnapps_c, mngets_c, mneupd_c - integer(kind=c_int), value, intent(in) :: mcaupd_c, mcaup2_c, mcaitr_c, mceigh_c, mcapps_c, mcgets_c, mceupd_c +#include "arpackicb.h" + integer(kind=i_int), value, intent(in) :: logfil_c, ndigit_c, mgetv0_c + integer(kind=i_int), value, intent(in) :: msaupd_c, msaup2_c, msaitr_c, mseigt_c, msapps_c, msgets_c, mseupd_c + integer(kind=i_int), value, intent(in) :: mnaupd_c, mnaup2_c, mnaitr_c, mneigh_c, mnapps_c, mngets_c, mneupd_c + integer(kind=i_int), value, intent(in) :: mcaupd_c, mcaup2_c, mcaitr_c, mceigh_c, mcapps_c, mcgets_c, mceupd_c include 'debug.h' logfil = logfil_c ndigit = ndigit_c diff -Nru arpack-3.7.0/ICB/parpack.h arpack-3.8.0/ICB/parpack.h --- arpack-3.7.0/ICB/parpack.h 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/ICB/parpack.h 2020-12-07 10:40:45.000000000 +0000 @@ -15,17 +15,17 @@ #endif void pcnaupd_c(MPI_Fint comm, a_int* ido, char const* bmat, a_int n, char const* which, a_int nev, float tol, float _Complex* resid, a_int ncv, float _Complex* v, a_int ldv, a_int* iparam, a_int* ipntr, float _Complex* workd, float _Complex* workl, a_int lworkl, float _Complex* rwork, a_int* info); -void pcneupd_c(MPI_Fint comm, bool rvec, char const* howmny, a_int const* select, float _Complex* d, float _Complex* z, a_int ldz, float _Complex sigma, float _Complex* workev, char const* bmat, a_int n, char const* which, a_int nev, float tol, float _Complex* resid, a_int ncv, float _Complex* v, a_int ldv, a_int* iparam, a_int* ipntr, float _Complex* workd, float _Complex* workl, a_int lworkl, float _Complex* rwork, a_int* info); +void pcneupd_c(MPI_Fint comm, a_int rvec, char const* howmny, a_int const* select, float _Complex* d, float _Complex* z, a_int ldz, float _Complex sigma, float _Complex* workev, char const* bmat, a_int n, char const* which, a_int nev, float tol, float _Complex* resid, a_int ncv, float _Complex* v, a_int ldv, a_int* iparam, a_int* ipntr, float _Complex* workd, float _Complex* workl, a_int lworkl, float _Complex* rwork, a_int* info); void pdnaupd_c(MPI_Fint comm, a_int* ido, char const* bmat, a_int n, char const* which, a_int nev, double tol, double* resid, a_int ncv, double* v, a_int ldv, a_int* iparam, a_int* ipntr, double* workd, double* workl, a_int lworkl, a_int* info); -void pdneupd_c(MPI_Fint comm, bool rvec, char const* howmny, a_int const* select, double* dr, double* di, double* z, a_int ldz, double sigmar, double sigmai, double * workev, char const* bmat, a_int n, char const* which, a_int nev, double tol, double* resid, a_int ncv, double* v, a_int ldv, a_int* iparam, a_int* ipntr, double* workd, double* workl, a_int lworkl, a_int* info); +void pdneupd_c(MPI_Fint comm, a_int rvec, char const* howmny, a_int const* select, double* dr, double* di, double* z, a_int ldz, double sigmar, double sigmai, double * workev, char const* bmat, a_int n, char const* which, a_int nev, double tol, double* resid, a_int ncv, double* v, a_int ldv, a_int* iparam, a_int* ipntr, double* workd, double* workl, a_int lworkl, a_int* info); void pdsaupd_c(MPI_Fint comm, a_int* ido, char const* bmat, a_int n, char const* which, a_int nev, double tol, double* resid, a_int ncv, double* v, a_int ldv, a_int* iparam, a_int* ipntr, double* workd, double* workl, a_int lworkl, a_int* info); -void pdseupd_c(MPI_Fint comm, bool rvec, char const* howmny, a_int const* select, double* d, double* z, a_int ldz, double sigma, char const* bmat, a_int n, char const* which, a_int nev, double tol, double* resid, a_int ncv, double* v, a_int ldv, a_int* iparam, a_int* ipntr, double* workd, double* workl, a_int lworkl, a_int* info); +void pdseupd_c(MPI_Fint comm, a_int rvec, char const* howmny, a_int const* select, double* d, double* z, a_int ldz, double sigma, char const* bmat, a_int n, char const* which, a_int nev, double tol, double* resid, a_int ncv, double* v, a_int ldv, a_int* iparam, a_int* ipntr, double* workd, double* workl, a_int lworkl, a_int* info); void psnaupd_c(MPI_Fint comm, a_int* ido, char const* bmat, a_int n, char const* which, a_int nev, float tol, float* resid, a_int ncv, float* v, a_int ldv, a_int* iparam, a_int* ipntr, float* workd, float* workl, a_int lworkl, a_int* info); -void psneupd_c(MPI_Fint comm, bool rvec, char const* howmny, a_int const* select, float* dr, float* di, float* z, a_int ldz, float sigmar, float sigmai, float * workev, char const* bmat, a_int n, char const* which, a_int nev, float tol, float* resid, a_int ncv, float* v, a_int ldv, a_int* iparam, a_int* ipntr, float* workd, float* workl, a_int lworkl, a_int* info); +void psneupd_c(MPI_Fint comm, a_int rvec, char const* howmny, a_int const* select, float* dr, float* di, float* z, a_int ldz, float sigmar, float sigmai, float * workev, char const* bmat, a_int n, char const* which, a_int nev, float tol, float* resid, a_int ncv, float* v, a_int ldv, a_int* iparam, a_int* ipntr, float* workd, float* workl, a_int lworkl, a_int* info); void pssaupd_c(MPI_Fint comm, a_int* ido, char const* bmat, a_int n, char const* which, a_int nev, float tol, float* resid, a_int ncv, float* v, a_int ldv, a_int* iparam, a_int* ipntr, float* workd, float* workl, a_int lworkl, a_int* info); -void psseupd_c(MPI_Fint comm, bool rvec, char const* howmny, a_int const* select, float* d, float* z, a_int ldz, float sigma, char const* bmat, a_int n, char const* which, a_int nev, float tol, float* resid, a_int ncv, float* v, a_int ldv, a_int* iparam, a_int* ipntr, float* workd, float* workl, a_int lworkl, a_int* info); +void psseupd_c(MPI_Fint comm, a_int rvec, char const* howmny, a_int const* select, float* d, float* z, a_int ldz, float sigma, char const* bmat, a_int n, char const* which, a_int nev, float tol, float* resid, a_int ncv, float* v, a_int ldv, a_int* iparam, a_int* ipntr, float* workd, float* workl, a_int lworkl, a_int* info); void pznaupd_c(MPI_Fint comm, a_int* ido, char const* bmat, a_int n, char const* which, a_int nev, double tol, double _Complex* resid, a_int ncv, double _Complex* v, a_int ldv, a_int* iparam, a_int* ipntr, double _Complex* workd, double _Complex* workl, a_int lworkl, double _Complex* rwork, a_int* info); -void pzneupd_c(MPI_Fint comm, bool rvec, char const* howmny, a_int const* select, double _Complex* d, double _Complex* z, a_int ldz, double _Complex sigma, double _Complex* workev, char const* bmat, a_int n, char const* which, a_int nev, double tol, double _Complex* resid, a_int ncv, double _Complex* v, a_int ldv, a_int* iparam, a_int* ipntr, double _Complex* workd, double _Complex* workl, a_int lworkl, double _Complex* rwork, a_int* info); +void pzneupd_c(MPI_Fint comm, a_int rvec, char const* howmny, a_int const* select, double _Complex* d, double _Complex* z, a_int ldz, double _Complex sigma, double _Complex* workev, char const* bmat, a_int n, char const* which, a_int nev, double tol, double _Complex* resid, a_int ncv, double _Complex* v, a_int ldv, a_int* iparam, a_int* ipntr, double _Complex* workd, double _Complex* workl, a_int lworkl, double _Complex* rwork, a_int* info); #ifdef __cplusplus } diff -Nru arpack-3.7.0/ICB/parpack.hpp arpack-3.8.0/ICB/parpack.hpp --- arpack-3.7.0/ICB/parpack.hpp 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/ICB/parpack.hpp 2020-12-07 10:40:45.000000000 +0000 @@ -25,7 +25,7 @@ ncv, v, ldv, iparam, ipntr, workd, workl, lworkl, &info); } -inline void seupd(MPI_Fint comm, bool rvec, howmny const howmny_option, +inline void seupd(MPI_Fint comm, a_int rvec, howmny const howmny_option, a_int* select, float* d, float* z, a_int ldz, float sigma, bmat const bmat_option, a_int n, which const which_option, a_int nev, float tol, float* resid, a_int ncv, float* v, a_int ldv, @@ -47,7 +47,7 @@ ncv, v, ldv, iparam, ipntr, workd, workl, lworkl, &info); } -inline void seupd(MPI_Fint comm, bool rvec, howmny const howmny_option, +inline void seupd(MPI_Fint comm, a_int rvec, howmny const howmny_option, a_int* select, double* d, double* z, a_int ldz, double sigma, bmat const bmat_option, a_int n, which const which_option, a_int nev, double tol, double* resid, a_int ncv, double* v, @@ -69,7 +69,7 @@ ncv, v, ldv, iparam, ipntr, workd, workl, lworkl, &info); } -inline void neupd(MPI_Fint comm, bool rvec, howmny const howmny_option, +inline void neupd(MPI_Fint comm, a_int rvec, howmny const howmny_option, a_int* select, float* dr, float* di, float* z, a_int ldz, float sigmar, float sigmai, float * workev, bmat const bmat_option, a_int n, @@ -92,7 +92,7 @@ ncv, v, ldv, iparam, ipntr, workd, workl, lworkl, &info); } -inline void neupd(MPI_Fint comm, bool rvec, howmny const howmny_option, +inline void neupd(MPI_Fint comm, a_int rvec, howmny const howmny_option, a_int* select, double* dr, double* di, double* z, a_int ldz, double sigmar, double sigmai, double * workev, bmat const bmat_option, a_int n, @@ -121,7 +121,7 @@ reinterpret_cast<_Complex float*>(rwork), &info); } -inline void neupd(MPI_Fint comm, bool rvec, howmny const howmny_option, +inline void neupd(MPI_Fint comm, a_int rvec, howmny const howmny_option, a_int* select, std::complex* d, std::complex* z, a_int ldz, std::complex sigma, std::complex* workev, bmat const bmat_option, a_int n, @@ -132,10 +132,11 @@ std::complex* rwork, a_int& info) { + std::complex sigma2 = sigma; internal::pcneupd_c(comm, rvec, internal::convert_to_char(howmny_option), select, reinterpret_cast<_Complex float*>(d), reinterpret_cast<_Complex float*>(z), ldz, - std::real(sigma) + _Complex_I * std::imag(sigma), + *reinterpret_cast<_Complex float*>(&sigma2), reinterpret_cast<_Complex float*>(workev), internal::convert_to_char(bmat_option), n, internal::convert_to_char(which_option), nev, tol, @@ -161,7 +162,7 @@ reinterpret_cast<_Complex double*>(rwork), &info); } -inline void neupd(MPI_Fint comm, bool rvec, howmny const howmny_option, +inline void neupd(MPI_Fint comm, a_int rvec, howmny const howmny_option, a_int* select, std::complex* d, std::complex* z, a_int ldz, std::complex sigma, std::complex* workev, bmat const bmat_option, a_int n, @@ -170,10 +171,11 @@ a_int ldv, a_int* iparam, a_int* ipntr, std::complex* workd, std::complex* workl, a_int lworkl, std::complex* rwork, a_int& info) { + std::complex sigma2 = sigma; internal::pzneupd_c(comm, rvec, internal::convert_to_char(howmny_option), select, reinterpret_cast<_Complex double*>(d), reinterpret_cast<_Complex double*>(z), ldz, - std::real(sigma) + _Complex_I * std::imag(sigma), + *reinterpret_cast<_Complex double*>(&sigma2), reinterpret_cast<_Complex double*>(workev), internal::convert_to_char(bmat_option), n, internal::convert_to_char(which_option), nev, tol, diff -Nru arpack-3.7.0/ICB/stat_c.h arpack-3.8.0/ICB/stat_c.h --- arpack-3.7.0/ICB/stat_c.h 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/ICB/stat_c.h 2020-12-07 10:40:45.000000000 +0000 @@ -1,13 +1,15 @@ #ifndef __STAT_C_H__ #define __STAT_C_H__ +#include "arpackdef.h" + /*Reset timers*/ extern void sstats_c(); extern void sstatn_c(); extern void cstatn_c(); /*Get timers*/ -extern void stat_c(int * nopx_c, int * nbx_c, int * nrorth_c, int * nitref_c, int * nrstrt_c, +extern void stat_c(a_int * nopx_c, a_int * nbx_c, a_int * nrorth_c, a_int * nitref_c, a_int * nrstrt_c, float * tsaupd_c, float * tsaup2_c, float * tsaitr_c, float * tseigt_c, float * tsgets_c, float * tsapps_c, float * tsconv_c, float * tnaupd_c, float * tnaup2_c, float * tnaitr_c, float * tneigh_c, float * tngets_c, float * tnapps_c, float * tnconv_c, float * tcaupd_c, float * tcaup2_c, float * tcaitr_c, float * tceigh_c, float * tcgets_c, float * tcapps_c, float * tcconv_c, diff -Nru arpack-3.7.0/ICB/stat_c.hpp arpack-3.8.0/ICB/stat_c.hpp --- arpack-3.7.0/ICB/stat_c.hpp 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/ICB/stat_c.hpp 2020-12-07 10:40:45.000000000 +0000 @@ -1,13 +1,15 @@ #ifndef __STAT_C_HPP__ #define __STAT_C_HPP__ +#include "arpackdef.h" + /*Reset timers*/ extern "C" void sstats_c(); extern "C" void sstatn_c(); extern "C" void cstatn_c(); /*Get timers*/ -extern "C" void stat_c(int & nopx_c, int & nbx_c, int & nrorth_c, int & nitref_c, int & nrstrt_c, +extern "C" void stat_c(a_int & nopx_c, a_int & nbx_c, a_int & nrorth_c, a_int & nitref_c, a_int & nrstrt_c, float & tsaupd_c, float & tsaup2_c, float & tsaitr_c, float & tseigt_c, float & tsgets_c, float & tsapps_c, float & tsconv_c, float & tnaupd_c, float & tnaup2_c, float & tnaitr_c, float & tneigh_c, float & tngets_c, float & tnapps_c, float & tnconv_c, float & tcaupd_c, float & tcaup2_c, float & tcaitr_c, float & tceigh_c, float & tcgets_c, float & tcapps_c, float & tcconv_c, diff -Nru arpack-3.7.0/ICB/stat_icb.F90 arpack-3.8.0/ICB/stat_icb.F90 --- arpack-3.7.0/ICB/stat_icb.F90 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/ICB/stat_icb.F90 2020-12-07 10:40:45.000000000 +0000 @@ -26,8 +26,8 @@ bind(c, name="stat_c") use :: iso_c_binding implicit none -#include "arpackdef.h" - integer(kind=c_int), intent(out) :: nopx_c, nbx_c, nrorth_c, nitref_c, nrstrt_c +#include "arpackicb.h" + integer(kind=i_int), intent(out) :: nopx_c, nbx_c, nrorth_c, nitref_c, nrstrt_c real(kind=c_float), intent(out) :: tsaupd_c, tsaup2_c, tsaitr_c, tseigt_c, tsgets_c, tsapps_c, tsconv_c,& tnaupd_c, tnaup2_c, tnaitr_c, tneigh_c, tngets_c, tnapps_c, tnconv_c,& tcaupd_c, tcaup2_c, tcaitr_c, tceigh_c, tcgets_c, tcapps_c, tcconv_c,& diff -Nru arpack-3.7.0/m4/ax_blas.m4 arpack-3.8.0/m4/ax_blas.m4 --- arpack-3.7.0/m4/ax_blas.m4 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/m4/ax_blas.m4 2020-12-07 10:40:45.000000000 +0000 @@ -1,5 +1,5 @@ # =========================================================================== -# http://www.gnu.org/software/autoconf-archive/ax_blas.html +# https://www.gnu.org/software/autoconf-archive/ax_blas.html # =========================================================================== # # SYNOPSIS @@ -36,6 +36,7 @@ # LICENSE # # Copyright (c) 2008 Steven G. Johnson +# Copyright (c) 2019 Geoffrey M. Oxberry # # This program is free software: you can redistribute it and/or modify it # under the terms of the GNU General Public License as published by the @@ -48,7 +49,7 @@ # Public License for more details. # # You should have received a copy of the GNU General Public License along -# with this program. If not, see . +# with this program. If not, see . # # As a special exception, the respective Autoconf Macro's copyright owner # gives unlimited permission to copy, distribute and modify the configure @@ -63,11 +64,11 @@ # modified version of the Autoconf Macro, you may extend this special # exception to the GPL to apply to your modified version as well. -#serial 14 +#serial 17 AU_ALIAS([ACX_BLAS], [AX_BLAS]) AC_DEFUN([AX_BLAS], [ -AC_PREREQ(2.50) +AC_PREREQ([2.55]) AC_REQUIRE([AC_F77_LIBRARY_LDFLAGS]) AC_REQUIRE([AC_CANONICAL_HOST]) ax_blas_ok=no @@ -77,7 +78,9 @@ case $with_blas in yes | "") ;; no) ax_blas_ok=disable ;; - -* | */* | *.a | *.so | *.so.* | *.o) BLAS_LIBS="$with_blas" ;; + -* | */* | *.a | *.so | *.so.* | *.dylib | *.dylib.* | *.o) + BLAS_LIBS="$with_blas" + ;; *) BLAS_LIBS="-l$with_blas" ;; esac @@ -93,7 +96,7 @@ if test "x$BLAS_LIBS" != x; then save_LIBS="$LIBS"; LIBS="$BLAS_LIBS $LIBS" AC_MSG_CHECKING([for $sgemm in $BLAS_LIBS]) - AC_TRY_LINK_FUNC($sgemm, [ax_blas_ok=yes], [BLAS_LIBS=""]) + AC_LINK_IFELSE([AC_LANG_CALL([], [$sgemm])], [ax_blas_ok=yes], [BLAS_LIBS=""]) AC_MSG_RESULT($ax_blas_ok) LIBS="$save_LIBS" fi @@ -103,7 +106,7 @@ if test $ax_blas_ok = no; then save_LIBS="$LIBS"; LIBS="$LIBS" AC_MSG_CHECKING([if $sgemm is being linked in already]) - AC_TRY_LINK_FUNC($sgemm, [ax_blas_ok=yes]) + AC_LINK_IFELSE([AC_LANG_CALL([], [$sgemm])], [ax_blas_ok=yes]) AC_MSG_RESULT($ax_blas_ok) LIBS="$save_LIBS" fi @@ -174,7 +177,7 @@ if test $ax_blas_ok = no; then save_LIBS="$LIBS"; LIBS="-framework vecLib $LIBS" AC_MSG_CHECKING([for $sgemm in -framework vecLib]) - AC_TRY_LINK_FUNC($sgemm, [ax_blas_ok=yes;BLAS_LIBS="-framework vecLib"]) + AC_LINK_IFELSE([AC_LANG_CALL([], [$sgemm])], [ax_blas_ok=yes;BLAS_LIBS="-framework vecLib"]) AC_MSG_RESULT($ax_blas_ok) LIBS="$save_LIBS" fi diff -Nru arpack-3.7.0/m4/ax_lapack.m4 arpack-3.8.0/m4/ax_lapack.m4 --- arpack-3.7.0/m4/ax_lapack.m4 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/m4/ax_lapack.m4 2020-12-07 10:40:45.000000000 +0000 @@ -1,5 +1,5 @@ # =========================================================================== -# http://www.gnu.org/software/autoconf-archive/ax_lapack.html +# https://www.gnu.org/software/autoconf-archive/ax_lapack.html # =========================================================================== # # SYNOPSIS @@ -37,6 +37,7 @@ # LICENSE # # Copyright (c) 2009 Steven G. Johnson +# Copyright (c) 2019 Geoffrey M. Oxberry # # This program is free software: you can redistribute it and/or modify it # under the terms of the GNU General Public License as published by the @@ -49,7 +50,7 @@ # Public License for more details. # # You should have received a copy of the GNU General Public License along -# with this program. If not, see . +# with this program. If not, see . # # As a special exception, the respective Autoconf Macro's copyright owner # gives unlimited permission to copy, distribute and modify the configure @@ -64,7 +65,7 @@ # modified version of the Autoconf Macro, you may extend this special # exception to the GPL to apply to your modified version as well. -#serial 7 +#serial 10 AU_ALIAS([ACX_LAPACK], [AX_LAPACK]) AC_DEFUN([AX_LAPACK], [ @@ -76,7 +77,9 @@ case $with_lapack in yes | "") ;; no) ax_lapack_ok=disable ;; - -* | */* | *.a | *.so | *.so.* | *.o) LAPACK_LIBS="$with_lapack" ;; + -* | */* | *.a | *.so | *.so.* | *.dylib | *.dylib.* | *.o) + LAPACK_LIBS="$with_lapack" + ;; *) LAPACK_LIBS="-l$with_lapack" ;; esac @@ -93,7 +96,7 @@ if test "x$LAPACK_LIBS" != x; then save_LIBS="$LIBS"; LIBS="$LAPACK_LIBS $BLAS_LIBS $LIBS $FLIBS" AC_MSG_CHECKING([for $cheev in $LAPACK_LIBS]) - AC_TRY_LINK_FUNC($cheev, [ax_lapack_ok=yes], [LAPACK_LIBS=""]) + AC_LINK_IFELSE([AC_LANG_CALL([], [$cheev])], [ax_lapack_ok=yes], [LAPACK_LIBS=""]) AC_MSG_RESULT($ax_lapack_ok) LIBS="$save_LIBS" if test $ax_lapack_ok = no; then diff -Nru arpack-3.7.0/Makefile.am arpack-3.8.0/Makefile.am --- arpack-3.7.0/Makefile.am 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/Makefile.am 2020-12-07 10:40:45.000000000 +0000 @@ -10,6 +10,9 @@ if ICB AM_DISTCHECK_CONFIGURE_FLAGS += --enable-icb endif +if ICBEXMM +AM_DISTCHECK_CONFIGURE_FLAGS += --enable-icb-exmm +endif SUBDIRS = . if ICB @@ -21,8 +24,7 @@ endif EXTRA_DIST = README.md PARPACK_CHANGES CHANGES DOCUMENTS VISUAL_STUDIO \ -detect_arpack_bug.m4 CMakeLists.txt arpack-ng-config.cmake.in arpack-ng-config-version.cmake.in - -pkgconfig_DATA = arpack@LIBSUFFIX@.pc +detect_arpack_bug.m4 CMakeLists.txt -DISTCLEANFILES = $(pkgconfig_DATA) arpackdef.h +cmakedir = $(libdir)/cmake/arpack-ng +cmake_DATA = arpack-ng-config.cmake arpack-ng-config-version.cmake diff -Nru arpack-3.7.0/.mergify.yml arpack-3.8.0/.mergify.yml --- arpack-3.7.0/.mergify.yml 1970-01-01 00:00:00.000000000 +0000 +++ arpack-3.8.0/.mergify.yml 2020-12-07 10:40:45.000000000 +0000 @@ -0,0 +1,8 @@ +pull_request_rules: + - name: automatic merge on CI success and review + conditions: + - status-success=continuous-integration/travis-ci/pr + - "#approved-reviews-by>=1" + actions: + merge: + method: merge diff -Nru arpack-3.7.0/PARPACK/EXAMPLES/MPI/README.CALLING-PARPACK-FROM-C-OR-CPP arpack-3.8.0/PARPACK/EXAMPLES/MPI/README.CALLING-PARPACK-FROM-C-OR-CPP --- arpack-3.7.0/PARPACK/EXAMPLES/MPI/README.CALLING-PARPACK-FROM-C-OR-CPP 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/PARPACK/EXAMPLES/MPI/README.CALLING-PARPACK-FROM-C-OR-CPP 2020-12-07 10:40:45.000000000 +0000 @@ -1,2 +1,5 @@ -In PARPACK/TESTS/MPI, the file icb_parpack_c.c is an example of how to call parpack from C. -In PARPACK/TESTS/MPI, the file icb_parpack_cpp.cpp is an example of how to call parpack from C++. +In PARPACK / TESTS / MPI, + the file icb_parpack_c.c is an example of how to call parpack from + C.In PARPACK / + TESTS / MPI, + the file icb_parpack_cpp.cpp is an example of how to call parpack from C++. diff -Nru arpack-3.7.0/PARPACK/SRC/BLACS/pcgetv0.f arpack-3.8.0/PARPACK/SRC/BLACS/pcgetv0.f --- arpack-3.7.0/PARPACK/SRC/BLACS/pcgetv0.f 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/PARPACK/SRC/BLACS/pcgetv0.f 2020-12-07 10:40:45.000000000 +0000 @@ -406,9 +406,9 @@ c %--------------------------------------% c if (msglvl .gt. 2) then - call psvout (comm, logfil, 1, rnorm0, ndigit, + call psvout (comm, logfil, 1, [rnorm0], ndigit, & '_getv0: re-orthonalization ; rnorm0 is') - call psvout (comm, logfil, 1, rnorm, ndigit, + call psvout (comm, logfil, 1, [rnorm], ndigit, & '_getv0: re-orthonalization ; rnorm is') end if c diff -Nru arpack-3.7.0/PARPACK/SRC/BLACS/pcnaitr.f arpack-3.8.0/PARPACK/SRC/BLACS/pcnaitr.f --- arpack-3.7.0/PARPACK/SRC/BLACS/pcnaitr.f 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/PARPACK/SRC/BLACS/pcnaitr.f 2020-12-07 10:40:45.000000000 +0000 @@ -401,9 +401,9 @@ 1000 continue c if (msglvl .gt. 1) then - call pivout (comm, logfil, 1, j, ndigit, + call pivout (comm, logfil, 1, [j], ndigit, & '_naitr: generating Arnoldi vector number') - call pcvout (comm, logfil, 1, rnorm, ndigit, + call pcvout (comm, logfil, 1, [rnorm], ndigit, & '_naitr: B-norm of the current residual is') end if c @@ -423,7 +423,7 @@ c %---------------------------------------------------% c if (msglvl .gt. 0) then - call pivout (comm, logfil, 1, j, ndigit, + call pivout (comm, logfil, 1, [j], ndigit, & '_naitr: ****** RESTART AT STEP ******') end if c @@ -757,7 +757,7 @@ end if c if (msglvl .gt. 0 .and. iter .gt. 0 ) then - call pivout (comm, logfil, 1, j, ndigit, + call pivout (comm, logfil, 1, [j], ndigit, & '_naitr: Iterative refinement for Arnoldi residual') if (msglvl .gt. 2) then rtemp(1) = rnorm diff -Nru arpack-3.7.0/PARPACK/SRC/BLACS/pcnapps.f arpack-3.8.0/PARPACK/SRC/BLACS/pcnapps.f --- arpack-3.7.0/PARPACK/SRC/BLACS/pcnapps.f 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/PARPACK/SRC/BLACS/pcnapps.f 2020-12-07 10:40:45.000000000 +0000 @@ -284,9 +284,9 @@ sigma = shift(jj) c if (msglvl .gt. 2 ) then - call pivout (comm, logfil, 1, jj, ndigit, + call pivout (comm, logfil, 1, [jj], ndigit, & '_napps: shift number.') - call pcvout (comm, logfil, 1, sigma, ndigit, + call pcvout (comm, logfil, 1, [sigma], ndigit, & '_napps: Value of the shift ') end if c @@ -307,9 +307,9 @@ if ( abs(real(h(i+1,i))) & .le. max(ulp*tst1, smlnum) ) then if (msglvl .gt. 0) then - call pivout (comm, logfil, 1, i, ndigit, + call pivout (comm, logfil, 1, [i], ndigit, & '_napps: matrix splitting at row/column no.') - call pivout (comm, logfil, 1, jj, ndigit, + call pivout (comm, logfil, 1, [jj], ndigit, & '_napps: matrix splitting with shift number.') call pcvout (comm, logfil, 1, h(i+1,i), ndigit, & '_napps: off diagonal element.') @@ -323,9 +323,9 @@ 40 continue c if (msglvl .gt. 2) then - call pivout (comm, logfil, 1, istart, ndigit, + call pivout (comm, logfil, 1, [istart], ndigit, & '_napps: Start of current block ') - call pivout (comm, logfil, 1, iend, ndigit, + call pivout (comm, logfil, 1, [iend], ndigit, & '_napps: End of current block ') end if c @@ -501,7 +501,7 @@ & '_napps: sigmak = (e_{kev+p}^T*Q)*e_{kev}') call pcvout (comm, logfil, 1, h(kev+1,kev), ndigit, & '_napps: betak = e_{kev+1}^T*H*e_{kev}') - call pivout (comm, logfil, 1, kev, ndigit, + call pivout (comm, logfil, 1, [kev], ndigit, & '_napps: Order of the final Hessenberg matrix ') if (msglvl .gt. 2) then call pcmout (comm, logfil, kev, kev, h, ldh, ndigit, diff -Nru arpack-3.7.0/PARPACK/SRC/BLACS/pcnaup2.f arpack-3.8.0/PARPACK/SRC/BLACS/pcnaup2.f --- arpack-3.7.0/PARPACK/SRC/BLACS/pcnaup2.f 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/PARPACK/SRC/BLACS/pcnaup2.f 2020-12-07 10:40:45.000000000 +0000 @@ -398,7 +398,7 @@ iter = iter + 1 c if (msglvl .gt. 0) then - call pivout (comm, logfil, 1, iter, ndigit, + call pivout (comm, logfil, 1, [iter], ndigit, & '_naup2: **** Start of major iteration number ****') end if c @@ -411,9 +411,9 @@ np = kplusp - nev c if (msglvl .gt. 1) then - call pivout (comm, logfil, 1, nev, ndigit, + call pivout (comm, logfil, 1, [nev], ndigit, & '_naup2: The length of the current Arnoldi factorization') - call pivout (comm, logfil, 1, np, ndigit, + call pivout (comm, logfil, 1, [np], ndigit, & '_naup2: Extend the Arnoldi factorization by') end if c @@ -440,7 +440,7 @@ update = .false. c if (msglvl .gt. 1) then - call psvout (comm, logfil, 1, rnorm, ndigit, + call psvout (comm, logfil, 1, [rnorm], ndigit, & '_naup2: Corresponding B-norm of the residual') end if c @@ -671,7 +671,7 @@ end if c if (msglvl .gt. 0) then - call pivout (comm, logfil, 1, nconv, ndigit, + call pivout (comm, logfil, 1, [nconv], ndigit, & '_naup2: no. of "converged" Ritz values at this iter.') if (msglvl .gt. 1) then kp(1) = nev @@ -711,7 +711,7 @@ end if c if (msglvl .gt. 2) then - call pivout (comm, logfil, 1, np, ndigit, + call pivout (comm, logfil, 1, [np], ndigit, & '_naup2: The number of shifts to apply ') call pcvout (comm, logfil, np, ritz, ndigit, & '_naup2: values of the shifts') @@ -776,7 +776,7 @@ cnorm = .false. c if (msglvl .gt. 2) then - call psvout (comm, logfil, 1, rnorm, ndigit, + call psvout (comm, logfil, 1, [rnorm], ndigit, & '_naup2: B-norm of residual for compressed factorization') call pcmout (comm, logfil, nev, nev, h, ldh, ndigit, & '_naup2: Compressed upper Hessenberg matrix H') diff -Nru arpack-3.7.0/PARPACK/SRC/BLACS/pcnaupd.f arpack-3.8.0/PARPACK/SRC/BLACS/pcnaupd.f --- arpack-3.7.0/PARPACK/SRC/BLACS/pcnaupd.f 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/PARPACK/SRC/BLACS/pcnaupd.f 2020-12-07 10:40:45.000000000 +0000 @@ -618,9 +618,9 @@ if (info .eq. 2) info = 3 c if (msglvl .gt. 0) then - call pivout (comm, logfil, 1, mxiter, ndigit, + call pivout (comm, logfil, 1, [mxiter], ndigit, & '_naupd: Number of update iterations taken') - call pivout (comm, logfil, 1, np, ndigit, + call pivout (comm, logfil, 1, [np], ndigit, & '_naupd: Number of wanted "converged" Ritz values') call pcvout (comm, logfil, np, workl(ritz), ndigit, & '_naupd: The final Ritz values') diff -Nru arpack-3.7.0/PARPACK/SRC/BLACS/pcneupd.f arpack-3.8.0/PARPACK/SRC/BLACS/pcneupd.f --- arpack-3.7.0/PARPACK/SRC/BLACS/pcneupd.f 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/PARPACK/SRC/BLACS/pcneupd.f 2020-12-07 10:40:45.000000000 +0000 @@ -558,9 +558,9 @@ c %-----------------------------------------------------------% c if (msglvl .gt. 2) then - call pivout(comm, logfil, 1, numcnv, ndigit, + call pivout(comm, logfil, 1, [numcnv], ndigit, & '_neupd: Number of specified eigenvalues') - call pivout(comm, logfil, 1, nconv, ndigit, + call pivout(comm, logfil, 1, [nconv], ndigit, & '_neupd: Number of "converged" eigenvalues') end if c diff -Nru arpack-3.7.0/PARPACK/SRC/BLACS/pcngets.f arpack-3.8.0/PARPACK/SRC/BLACS/pcngets.f --- arpack-3.7.0/PARPACK/SRC/BLACS/pcngets.f 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/PARPACK/SRC/BLACS/pcngets.f 2020-12-07 10:40:45.000000000 +0000 @@ -177,8 +177,8 @@ tcgets = tcgets + (t1 - t0) c if (msglvl .gt. 0) then - call pivout (comm, logfil, 1, kev, ndigit, '_ngets: KEV is') - call pivout (comm, logfil, 1, np, ndigit, '_ngets: NP is') + call pivout (comm, logfil, 1, [kev], ndigit, '_ngets: KEV is') + call pivout (comm, logfil, 1, [np], ndigit, '_ngets: NP is') call pcvout (comm, logfil, kev+np, ritz, ndigit, & '_ngets: Eigenvalues of current H matrix ') call pcvout (comm, logfil, kev+np, bounds, ndigit, diff -Nru arpack-3.7.0/PARPACK/SRC/BLACS/pdgetv0.f arpack-3.8.0/PARPACK/SRC/BLACS/pdgetv0.f --- arpack-3.7.0/PARPACK/SRC/BLACS/pdgetv0.f 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/PARPACK/SRC/BLACS/pdgetv0.f 2020-12-07 10:40:45.000000000 +0000 @@ -385,9 +385,9 @@ c %--------------------------------------% c if (msglvl .gt. 2) then - call pdvout (comm, logfil, 1, rnorm0, ndigit, + call pdvout (comm, logfil, 1, [rnorm0], ndigit, & '_getv0: re-orthonalization ; rnorm0 is') - call pdvout (comm, logfil, 1, rnorm, ndigit, + call pdvout (comm, logfil, 1, [rnorm], ndigit, & '_getv0: re-orthonalization ; rnorm is') end if c @@ -418,7 +418,7 @@ 50 continue c if (msglvl .gt. 0) then - call pdvout (comm, logfil, 1, rnorm, ndigit, + call pdvout (comm, logfil, 1, [rnorm], ndigit, & '_getv0: B-norm of initial / restarted starting vector') end if if (msglvl .gt. 2) then diff -Nru arpack-3.7.0/PARPACK/SRC/BLACS/pdnaitr.f arpack-3.8.0/PARPACK/SRC/BLACS/pdnaitr.f --- arpack-3.7.0/PARPACK/SRC/BLACS/pdnaitr.f 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/PARPACK/SRC/BLACS/pdnaitr.f 2020-12-07 10:40:45.000000000 +0000 @@ -390,9 +390,9 @@ 1000 continue c if (msglvl .gt. 1) then - call pivout (comm, logfil, 1, j, ndigit, + call pivout (comm, logfil, 1, [j], ndigit, & '_naitr: generating Arnoldi vector number') - call pdvout (comm, logfil, 1, rnorm, ndigit, + call pdvout (comm, logfil, 1, [rnorm], ndigit, & '_naitr: B-norm of the current residual is') end if c @@ -412,7 +412,7 @@ c %---------------------------------------------------% c if (msglvl .gt. 0) then - call pivout (comm, logfil, 1, j, ndigit, + call pivout (comm, logfil, 1, [j], ndigit, & '_naitr: ****** RESTART AT STEP ******') end if c @@ -745,7 +745,7 @@ end if c if (msglvl .gt. 0 .and. iter .gt. 0) then - call pivout (comm, logfil, 1, j, ndigit, + call pivout (comm, logfil, 1, [j], ndigit, & '_naitr: Iterative refinement for Arnoldi residual') if (msglvl .gt. 2) then xtemp(1) = rnorm diff -Nru arpack-3.7.0/PARPACK/SRC/BLACS/pdnapps.f arpack-3.8.0/PARPACK/SRC/BLACS/pdnapps.f --- arpack-3.7.0/PARPACK/SRC/BLACS/pdnapps.f 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/PARPACK/SRC/BLACS/pdnapps.f 2020-12-07 10:40:45.000000000 +0000 @@ -276,11 +276,11 @@ sigmai = shifti(jj) c if (msglvl .gt. 2 ) then - call pivout (comm, logfil, 1, jj, ndigit, + call pivout (comm, logfil, 1, [jj], ndigit, & '_napps: shift number.') - call pdvout (comm, logfil, 1, sigmar, ndigit, + call pdvout (comm, logfil, 1, [sigmar], ndigit, & '_napps: The real part of the shift ') - call pdvout (comm, logfil, 1, sigmai, ndigit, + call pdvout (comm, logfil, 1, [sigmai], ndigit, & '_napps: The imaginary part of the shift ') end if c @@ -347,7 +347,7 @@ if (msglvl .gt. 0) then call pivout (comm, logfil, 1, i, ndigit, & '_napps: matrix splitting at row/column no.') - call pivout (comm, logfil, 1, jj, ndigit, + call pivout (comm, logfil, 1, [jj], ndigit, & '_napps: matrix splitting with shift number.') call pdvout (comm, logfil, 1, h(i+1,i), ndigit, & '_napps: off diagonal element.') @@ -361,9 +361,9 @@ 40 continue c if (msglvl .gt. 2) then - call pivout (comm, logfil, 1, istart, ndigit, + call pivout (comm, logfil, 1, [istart], ndigit, & '_napps: Start of current block ') - call pivout (comm, logfil, 1, iend, ndigit, + call pivout (comm, logfil, 1, [iend], ndigit, & '_napps: End of current block ') end if c @@ -635,7 +635,7 @@ & '_napps: sigmak = (e_{kev+p}^T*Q)*e_{kev}') call pdvout (comm, logfil, 1, h(kev+1,kev), ndigit, & '_napps: betak = e_{kev+1}^T*H*e_{kev}') - call pivout (comm, logfil, 1, kev, ndigit, + call pivout (comm, logfil, 1, [kev], ndigit, & '_napps: Order of the final Hessenberg matrix ') if (msglvl .gt. 2) then call pdmout (comm, logfil, kev, kev, h, ldh, ndigit, diff -Nru arpack-3.7.0/PARPACK/SRC/BLACS/pdnaup2.f arpack-3.8.0/PARPACK/SRC/BLACS/pdnaup2.f --- arpack-3.7.0/PARPACK/SRC/BLACS/pdnaup2.f 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/PARPACK/SRC/BLACS/pdnaup2.f 2020-12-07 10:40:45.000000000 +0000 @@ -405,7 +405,7 @@ iter = iter + 1 c if (msglvl .gt. 0) then - call pivout (comm, logfil, 1, iter, ndigit, + call pivout (comm, logfil, 1, [iter], ndigit, & '_naup2: **** Start of major iteration number ****') end if c @@ -418,9 +418,9 @@ np = kplusp - nev c if (msglvl .gt. 1) then - call pivout (comm, logfil, 1, nev, ndigit, + call pivout (comm, logfil, 1, [nev], ndigit, & '_naup2: The length of the current Arnoldi factorization') - call pivout (comm, logfil, 1, np, ndigit, + call pivout (comm, logfil, 1, [np], ndigit, & '_naup2: Extend the Arnoldi factorization by') end if c @@ -452,7 +452,7 @@ update = .false. c if (msglvl .gt. 1) then - call pdvout (comm, logfil, 1, rnorm, ndigit, + call pdvout (comm, logfil, 1, [rnorm], ndigit, & '_naup2: Corresponding B-norm of the residual') end if c @@ -696,7 +696,7 @@ end if c if (msglvl .gt. 0) then - call pivout (comm, logfil, 1, nconv, ndigit, + call pivout (comm, logfil, 1, [nconv], ndigit, & '_naup2: no. of "converged" Ritz values at this iter.') if (msglvl .gt. 1) then kp(1) = nev @@ -748,7 +748,7 @@ end if c if (msglvl .gt. 2) then - call pivout (comm, logfil, 1, np, ndigit, + call pivout (comm, logfil, 1, [np], ndigit, & '_naup2: The number of shifts to apply ') call pdvout (comm, logfil, np, ritzr, ndigit, & '_naup2: Real part of the shifts') @@ -815,7 +815,7 @@ cnorm = .false. c if (msglvl .gt. 2) then - call pdvout (comm, logfil, 1, rnorm, ndigit, + call pdvout (comm, logfil, 1, [rnorm], ndigit, & '_naup2: B-norm of residual for compressed factorization') call pdmout (comm, logfil, nev, nev, h, ldh, ndigit, & '_naup2: Compressed upper Hessenberg matrix H') diff -Nru arpack-3.7.0/PARPACK/SRC/BLACS/pdnaupd.f arpack-3.8.0/PARPACK/SRC/BLACS/pdnaupd.f --- arpack-3.7.0/PARPACK/SRC/BLACS/pdnaupd.f 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/PARPACK/SRC/BLACS/pdnaupd.f 2020-12-07 10:40:45.000000000 +0000 @@ -642,9 +642,9 @@ if (info .eq. 2) info = 3 c if (msglvl .gt. 0) then - call pivout (comm, logfil, 1, mxiter, ndigit, + call pivout (comm, logfil, 1, [mxiter], ndigit, & '_naupd: Number of update iterations taken') - call pivout (comm, logfil, 1, np, ndigit, + call pivout (comm, logfil, 1, [np], ndigit, & '_naupd: Number of wanted "converged" Ritz values') call pdvout (comm, logfil, np, workl(ritzr), ndigit, & '_naupd: Real part of the final Ritz values') diff -Nru arpack-3.7.0/PARPACK/SRC/BLACS/pdneupd.f arpack-3.8.0/PARPACK/SRC/BLACS/pdneupd.f --- arpack-3.7.0/PARPACK/SRC/BLACS/pdneupd.f 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/PARPACK/SRC/BLACS/pdneupd.f 2020-12-07 10:40:45.000000000 +0000 @@ -617,9 +617,9 @@ c %-----------------------------------------------------------% c if (msglvl .gt. 2) then - call pivout(comm, logfil, 1, numcnv, ndigit, + call pivout(comm, logfil, 1, [numcnv], ndigit, & '_neupd: Number of specified eigenvalues') - call pivout(comm, logfil, 1, nconv, ndigit, + call pivout(comm, logfil, 1, [nconv], ndigit, & '_neupd: Number of "converged" eigenvalues') end if c diff -Nru arpack-3.7.0/PARPACK/SRC/BLACS/pdngets.f arpack-3.8.0/PARPACK/SRC/BLACS/pdngets.f --- arpack-3.7.0/PARPACK/SRC/BLACS/pdngets.f 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/PARPACK/SRC/BLACS/pdngets.f 2020-12-07 10:40:45.000000000 +0000 @@ -226,8 +226,8 @@ tngets = tngets + (t1 - t0) c if (msglvl .gt. 0) then - call pivout (comm, logfil, 1, kev, ndigit, '_ngets: KEV is') - call pivout (comm, logfil, 1, np, ndigit, '_ngets: NP is') + call pivout (comm, logfil, 1, [kev], ndigit, '_ngets: KEV is') + call pivout (comm, logfil, 1, [np], ndigit, '_ngets: NP is') call pdvout (comm, logfil, kev+np, ritzr, ndigit, & '_ngets: Eigenvalues of current H matrix -- real part') call pdvout (comm, logfil, kev+np, ritzi, ndigit, diff -Nru arpack-3.7.0/PARPACK/SRC/BLACS/pdsaitr.f arpack-3.8.0/PARPACK/SRC/BLACS/pdsaitr.f --- arpack-3.7.0/PARPACK/SRC/BLACS/pdsaitr.f 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/PARPACK/SRC/BLACS/pdsaitr.f 2020-12-07 10:40:45.000000000 +0000 @@ -389,9 +389,9 @@ 1000 continue c if (msglvl .gt. 2) then - call pivout (comm, logfil, 1, j, ndigit, + call pivout (comm, logfil, 1, [j], ndigit, & '_saitr: generating Arnoldi vector no.') - call pdvout (comm, logfil, 1, rnorm, ndigit, + call pdvout (comm, logfil, 1, [rnorm], ndigit, & '_saitr: B-norm of the current residual =') end if c @@ -409,7 +409,7 @@ c %---------------------------------------------------% c if (msglvl .gt. 0) then - call pivout (comm, logfil, 1, j, ndigit, + call pivout (comm, logfil, 1, [j], ndigit, & '_saitr: ****** restart at step ******') end if c @@ -767,7 +767,7 @@ end if c if (msglvl .gt. 0 .and. iter .gt. 0) then - call pivout (comm, logfil, 1, j, ndigit, + call pivout (comm, logfil, 1, [j], ndigit, & '_naitr: Iterative refinement for Arnoldi residual') if (msglvl .gt. 2) then xtemp(1) = rnorm diff -Nru arpack-3.7.0/PARPACK/SRC/BLACS/pdsapps.f arpack-3.8.0/PARPACK/SRC/BLACS/pdsapps.f --- arpack-3.7.0/PARPACK/SRC/BLACS/pdsapps.f 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/PARPACK/SRC/BLACS/pdsapps.f 2020-12-07 10:40:45.000000000 +0000 @@ -272,9 +272,9 @@ big = abs(h(i,2)) + abs(h(i+1,2)) if (h(i+1,1) .le. epsmch*big) then if (msglvl .gt. 0) then - call pivout (comm, logfil, 1, i, ndigit, + call pivout (comm, logfil, 1, [i], ndigit, & '_sapps: deflation at row/column no.') - call pivout (comm, logfil, 1, jj, ndigit, + call pivout (comm, logfil, 1, [jj], ndigit, & '_sapps: occurred before shift number.') call pdvout (comm, logfil, 1, h(i+1,1), ndigit, & '_sapps: the corresponding off diagonal element') @@ -443,7 +443,7 @@ big = abs(h(i,2)) + abs(h(i+1,2)) if (h(i+1,1) .le. epsmch*big) then if (msglvl .gt. 0) then - call pivout (comm, logfil, 1, i, ndigit, + call pivout (comm, logfil, 1, [i], ndigit, & '_sapps: deflation at row/column no.') call pdvout (comm, logfil, 1, h(i+1,1), ndigit, & '_sapps: the corresponding off diagonal element') diff -Nru arpack-3.7.0/PARPACK/SRC/BLACS/pdsaup2.f arpack-3.8.0/PARPACK/SRC/BLACS/pdsaup2.f --- arpack-3.7.0/PARPACK/SRC/BLACS/pdsaup2.f 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/PARPACK/SRC/BLACS/pdsaup2.f 2020-12-07 10:40:45.000000000 +0000 @@ -421,13 +421,13 @@ iter = iter + 1 c if (msglvl .gt. 0) then - call pivout (comm, logfil, 1, iter, ndigit, + call pivout (comm, logfil, 1, [iter], ndigit, & '_saup2: **** Start of major iteration number ****') end if if (msglvl .gt. 1) then - call pivout (comm, logfil, 1, nev, ndigit, + call pivout (comm, logfil, 1, [nev], ndigit, & '_saup2: The length of the current Lanczos factorization') - call pivout (comm, logfil, 1, np, ndigit, + call pivout (comm, logfil, 1, [np], ndigit, & '_saup2: Extend the Lanczos factorization by') end if c @@ -466,7 +466,7 @@ update = .false. c if (msglvl .gt. 1) then - call pdvout (comm, logfil, 1, rnorm, ndigit, + call pdvout (comm, logfil, 1, [rnorm], ndigit, & '_saup2: Current B-norm of residual for factorization') end if c @@ -716,7 +716,7 @@ end if c if (msglvl .gt. 0) then - call pivout (comm, logfil, 1, nconv, ndigit, + call pivout (comm, logfil, 1, [nconv], ndigit, & '_saup2: no. of "converged" Ritz values at this iter.') if (msglvl .gt. 1) then kp(1) = nev @@ -763,7 +763,7 @@ if (ishift .eq. 0) call dcopy (np, workl, 1, ritz, 1) c if (msglvl .gt. 2) then - call pivout (comm, logfil, 1, np, ndigit, + call pivout (comm, logfil, 1, [np], ndigit, & '_saup2: The number of shifts to apply ') call pdvout (comm, logfil, np, workl, ndigit, & '_saup2: shifts selected') @@ -831,7 +831,7 @@ 130 continue c if (msglvl .gt. 2) then - call pdvout (comm, logfil, 1, rnorm, ndigit, + call pdvout (comm, logfil, 1, [rnorm], ndigit, & '_saup2: B-norm of residual for NEV factorization') call pdvout (comm, logfil, nev, h(1,2), ndigit, & '_saup2: main diagonal of compressed H matrix') diff -Nru arpack-3.7.0/PARPACK/SRC/BLACS/pdsaupd.f arpack-3.8.0/PARPACK/SRC/BLACS/pdsaupd.f --- arpack-3.7.0/PARPACK/SRC/BLACS/pdsaupd.f 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/PARPACK/SRC/BLACS/pdsaupd.f 2020-12-07 10:40:45.000000000 +0000 @@ -644,9 +644,9 @@ if (info .eq. 2) info = 3 c if (msglvl .gt. 0) then - call pivout (comm, logfil, 1, mxiter, ndigit, + call pivout (comm, logfil, 1, [mxiter], ndigit, & '_saupd: number of update iterations taken') - call pivout (comm, logfil, 1, np, ndigit, + call pivout (comm, logfil, 1, [np], ndigit, & '_saupd: number of "converged" Ritz values') call pdvout (comm, logfil, np, workl(Ritz), ndigit, & '_saupd: final Ritz values') diff -Nru arpack-3.7.0/PARPACK/SRC/BLACS/pdseupd.f arpack-3.8.0/PARPACK/SRC/BLACS/pdseupd.f --- arpack-3.7.0/PARPACK/SRC/BLACS/pdseupd.f 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/PARPACK/SRC/BLACS/pdseupd.f 2020-12-07 10:40:45.000000000 +0000 @@ -523,9 +523,9 @@ c %-----------------------------------------------------------% c if (msglvl .gt. 2) then - call pivout(comm, logfil, 1, numcnv, ndigit, + call pivout(comm, logfil, 1, [numcnv], ndigit, & '_neupd: Number of specified eigenvalues') - call pivout(comm, logfil, 1, nconv, ndigit, + call pivout(comm, logfil, 1, [nconv], ndigit, & '_neupd: Number of "converged" eigenvalues') end if c diff -Nru arpack-3.7.0/PARPACK/SRC/BLACS/pdsgets.f arpack-3.8.0/PARPACK/SRC/BLACS/pdsgets.f --- arpack-3.7.0/PARPACK/SRC/BLACS/pdsgets.f 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/PARPACK/SRC/BLACS/pdsgets.f 2020-12-07 10:40:45.000000000 +0000 @@ -216,8 +216,8 @@ tsgets = tsgets + (t1 - t0) c if (msglvl .gt. 0) then - call pivout (comm, logfil, 1, kev, ndigit, '_sgets: KEV is') - call pivout (comm, logfil, 1, np, ndigit, '_sgets: NP is') + call pivout (comm, logfil, 1, [kev], ndigit, '_sgets: KEV is') + call pivout (comm, logfil, 1, [np], ndigit, '_sgets: NP is') call pdvout (comm, logfil, kev+np, ritz, ndigit, & '_sgets: Eigenvalues of current H matrix') call pdvout (comm, logfil, kev+np, bounds, ndigit, diff -Nru arpack-3.7.0/PARPACK/SRC/BLACS/psgetv0.f arpack-3.8.0/PARPACK/SRC/BLACS/psgetv0.f --- arpack-3.7.0/PARPACK/SRC/BLACS/psgetv0.f 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/PARPACK/SRC/BLACS/psgetv0.f 2020-12-07 10:40:45.000000000 +0000 @@ -385,9 +385,9 @@ c %--------------------------------------% c if (msglvl .gt. 2) then - call psvout (comm, logfil, 1, rnorm0, ndigit, + call psvout (comm, logfil, 1, [rnorm0], ndigit, & '_getv0: re-orthonalization ; rnorm0 is') - call psvout (comm, logfil, 1, rnorm, ndigit, + call psvout (comm, logfil, 1, [rnorm], ndigit, & '_getv0: re-orthonalization ; rnorm is') end if c @@ -418,7 +418,7 @@ 50 continue c if (msglvl .gt. 0) then - call psvout (comm, logfil, 1, rnorm, ndigit, + call psvout (comm, logfil, 1, [rnorm], ndigit, & '_getv0: B-norm of initial / restarted starting vector') end if if (msglvl .gt. 2) then diff -Nru arpack-3.7.0/PARPACK/SRC/BLACS/psnaitr.f arpack-3.8.0/PARPACK/SRC/BLACS/psnaitr.f --- arpack-3.7.0/PARPACK/SRC/BLACS/psnaitr.f 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/PARPACK/SRC/BLACS/psnaitr.f 2020-12-07 10:40:45.000000000 +0000 @@ -390,9 +390,9 @@ 1000 continue c if (msglvl .gt. 1) then - call pivout (comm, logfil, 1, j, ndigit, + call pivout (comm, logfil, 1, [j], ndigit, & '_naitr: generating Arnoldi vector number') - call psvout (comm, logfil, 1, rnorm, ndigit, + call psvout (comm, logfil, 1, [rnorm], ndigit, & '_naitr: B-norm of the current residual is') end if c @@ -412,7 +412,7 @@ c %---------------------------------------------------% c if (msglvl .gt. 0) then - call pivout (comm, logfil, 1, j, ndigit, + call pivout (comm, logfil, 1, [j], ndigit, & '_naitr: ****** RESTART AT STEP ******') end if c @@ -745,7 +745,7 @@ end if c if (msglvl .gt. 0 .and. iter .gt. 0) then - call pivout (comm, logfil, 1, j, ndigit, + call pivout (comm, logfil, 1, [j], ndigit, & '_naitr: Iterative refinement for Arnoldi residual') if (msglvl .gt. 2) then xtemp(1) = rnorm diff -Nru arpack-3.7.0/PARPACK/SRC/BLACS/psnapps.f arpack-3.8.0/PARPACK/SRC/BLACS/psnapps.f --- arpack-3.7.0/PARPACK/SRC/BLACS/psnapps.f 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/PARPACK/SRC/BLACS/psnapps.f 2020-12-07 10:40:45.000000000 +0000 @@ -276,11 +276,11 @@ sigmai = shifti(jj) c if (msglvl .gt. 2 ) then - call pivout (comm, logfil, 1, jj, ndigit, + call pivout (comm, logfil, 1, [jj], ndigit, & '_napps: shift number.') - call psvout (comm, logfil, 1, sigmar, ndigit, + call psvout (comm, logfil, 1, [sigmar], ndigit, & '_napps: The real part of the shift ') - call psvout (comm, logfil, 1, sigmai, ndigit, + call psvout (comm, logfil, 1, [sigmai], ndigit, & '_napps: The imaginary part of the shift ') end if c @@ -347,7 +347,7 @@ if (msglvl .gt. 0) then call pivout (comm, logfil, 1, i, ndigit, & '_napps: matrix splitting at row/column no.') - call pivout (comm, logfil, 1, jj, ndigit, + call pivout (comm, logfil, 1, [jj], ndigit, & '_napps: matrix splitting with shift number.') call psvout (comm, logfil, 1, h(i+1,i), ndigit, & '_napps: off diagonal element.') @@ -361,9 +361,9 @@ 40 continue c if (msglvl .gt. 2) then - call pivout (comm, logfil, 1, istart, ndigit, + call pivout (comm, logfil, 1, [istart], ndigit, & '_napps: Start of current block ') - call pivout (comm, logfil, 1, iend, ndigit, + call pivout (comm, logfil, 1, [iend], ndigit, & '_napps: End of current block ') end if c @@ -635,7 +635,7 @@ & '_napps: sigmak = (e_{kev+p}^T*Q)*e_{kev}') call psvout (comm, logfil, 1, h(kev+1,kev), ndigit, & '_napps: betak = e_{kev+1}^T*H*e_{kev}') - call pivout (comm, logfil, 1, kev, ndigit, + call pivout (comm, logfil, 1, [kev], ndigit, & '_napps: Order of the final Hessenberg matrix ') if (msglvl .gt. 2) then call psmout (comm, logfil, kev, kev, h, ldh, ndigit, diff -Nru arpack-3.7.0/PARPACK/SRC/BLACS/psnaup2.f arpack-3.8.0/PARPACK/SRC/BLACS/psnaup2.f --- arpack-3.7.0/PARPACK/SRC/BLACS/psnaup2.f 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/PARPACK/SRC/BLACS/psnaup2.f 2020-12-07 10:40:45.000000000 +0000 @@ -405,7 +405,7 @@ iter = iter + 1 c if (msglvl .gt. 0) then - call pivout (comm, logfil, 1, iter, ndigit, + call pivout (comm, logfil, 1, [iter], ndigit, & '_naup2: **** Start of major iteration number ****') end if c @@ -418,9 +418,9 @@ np = kplusp - nev c if (msglvl .gt. 1) then - call pivout (comm, logfil, 1, nev, ndigit, + call pivout (comm, logfil, 1, [nev], ndigit, & '_naup2: The length of the current Arnoldi factorization') - call pivout (comm, logfil, 1, np, ndigit, + call pivout (comm, logfil, 1, [np], ndigit, & '_naup2: Extend the Arnoldi factorization by') end if c @@ -452,7 +452,7 @@ update = .false. c if (msglvl .gt. 1) then - call psvout (comm, logfil, 1, rnorm, ndigit, + call psvout (comm, logfil, 1, [rnorm], ndigit, & '_naup2: Corresponding B-norm of the residual') end if c @@ -696,7 +696,7 @@ end if c if (msglvl .gt. 0) then - call pivout (comm, logfil, 1, nconv, ndigit, + call pivout (comm, logfil, 1, [nconv], ndigit, & '_naup2: no. of "converged" Ritz values at this iter.') if (msglvl .gt. 1) then kp(1) = nev @@ -748,7 +748,7 @@ end if c if (msglvl .gt. 2) then - call pivout (comm, logfil, 1, np, ndigit, + call pivout (comm, logfil, 1, [np], ndigit, & '_naup2: The number of shifts to apply ') call psvout (comm, logfil, np, ritzr, ndigit, & '_naup2: Real part of the shifts') @@ -815,7 +815,7 @@ cnorm = .false. c if (msglvl .gt. 2) then - call psvout (comm, logfil, 1, rnorm, ndigit, + call psvout (comm, logfil, 1, [rnorm], ndigit, & '_naup2: B-norm of residual for compressed factorization') call psmout (comm, logfil, nev, nev, h, ldh, ndigit, & '_naup2: Compressed upper Hessenberg matrix H') diff -Nru arpack-3.7.0/PARPACK/SRC/BLACS/psnaupd.f arpack-3.8.0/PARPACK/SRC/BLACS/psnaupd.f --- arpack-3.7.0/PARPACK/SRC/BLACS/psnaupd.f 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/PARPACK/SRC/BLACS/psnaupd.f 2020-12-07 10:40:45.000000000 +0000 @@ -642,9 +642,9 @@ if (info .eq. 2) info = 3 c if (msglvl .gt. 0) then - call pivout (comm, logfil, 1, mxiter, ndigit, + call pivout (comm, logfil, 1, [mxiter], ndigit, & '_naupd: Number of update iterations taken') - call pivout (comm, logfil, 1, np, ndigit, + call pivout (comm, logfil, 1, [np], ndigit, & '_naupd: Number of wanted "converged" Ritz values') call psvout (comm, logfil, np, workl(ritzr), ndigit, & '_naupd: Real part of the final Ritz values') diff -Nru arpack-3.7.0/PARPACK/SRC/BLACS/psneupd.f arpack-3.8.0/PARPACK/SRC/BLACS/psneupd.f --- arpack-3.7.0/PARPACK/SRC/BLACS/psneupd.f 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/PARPACK/SRC/BLACS/psneupd.f 2020-12-07 10:40:45.000000000 +0000 @@ -617,9 +617,9 @@ c %-----------------------------------------------------------% c if (msglvl .gt. 2) then - call pivout(comm, logfil, 1, numcnv, ndigit, + call pivout(comm, logfil, 1, [numcnv], ndigit, & '_neupd: Number of specified eigenvalues') - call pivout(comm, logfil, 1, nconv, ndigit, + call pivout(comm, logfil, 1, [nconv], ndigit, & '_neupd: Number of "converged" eigenvalues') end if c diff -Nru arpack-3.7.0/PARPACK/SRC/BLACS/psngets.f arpack-3.8.0/PARPACK/SRC/BLACS/psngets.f --- arpack-3.7.0/PARPACK/SRC/BLACS/psngets.f 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/PARPACK/SRC/BLACS/psngets.f 2020-12-07 10:40:45.000000000 +0000 @@ -226,8 +226,8 @@ tngets = tngets + (t1 - t0) c if (msglvl .gt. 0) then - call pivout (comm, logfil, 1, kev, ndigit, '_ngets: KEV is') - call pivout (comm, logfil, 1, np, ndigit, '_ngets: NP is') + call pivout (comm, logfil, 1, [kev], ndigit, '_ngets: KEV is') + call pivout (comm, logfil, 1, [np], ndigit, '_ngets: NP is') call psvout (comm, logfil, kev+np, ritzr, ndigit, & '_ngets: Eigenvalues of current H matrix -- real part') call psvout (comm, logfil, kev+np, ritzi, ndigit, diff -Nru arpack-3.7.0/PARPACK/SRC/BLACS/pssaitr.f arpack-3.8.0/PARPACK/SRC/BLACS/pssaitr.f --- arpack-3.7.0/PARPACK/SRC/BLACS/pssaitr.f 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/PARPACK/SRC/BLACS/pssaitr.f 2020-12-07 10:40:45.000000000 +0000 @@ -389,9 +389,9 @@ 1000 continue c if (msglvl .gt. 2) then - call pivout (comm, logfil, 1, j, ndigit, + call pivout (comm, logfil, 1, [j], ndigit, & '_saitr: generating Arnoldi vector no.') - call psvout (comm, logfil, 1, rnorm, ndigit, + call psvout (comm, logfil, 1, [rnorm], ndigit, & '_saitr: B-norm of the current residual =') end if c @@ -409,7 +409,7 @@ c %---------------------------------------------------% c if (msglvl .gt. 0) then - call pivout (comm, logfil, 1, j, ndigit, + call pivout (comm, logfil, 1, [j], ndigit, & '_saitr: ****** restart at step ******') end if c @@ -767,7 +767,7 @@ end if c if (msglvl .gt. 0 .and. iter .gt. 0) then - call pivout (comm, logfil, 1, j, ndigit, + call pivout (comm, logfil, 1, [j], ndigit, & '_naitr: Iterative refinement for Arnoldi residual') if (msglvl .gt. 2) then xtemp(1) = rnorm diff -Nru arpack-3.7.0/PARPACK/SRC/BLACS/pssapps.f arpack-3.8.0/PARPACK/SRC/BLACS/pssapps.f --- arpack-3.7.0/PARPACK/SRC/BLACS/pssapps.f 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/PARPACK/SRC/BLACS/pssapps.f 2020-12-07 10:40:45.000000000 +0000 @@ -272,9 +272,9 @@ big = abs(h(i,2)) + abs(h(i+1,2)) if (h(i+1,1) .le. epsmch*big) then if (msglvl .gt. 0) then - call pivout (comm, logfil, 1, i, ndigit, + call pivout (comm, logfil, 1, [i], ndigit, & '_sapps: deflation at row/column no.') - call pivout (comm, logfil, 1, jj, ndigit, + call pivout (comm, logfil, 1, [jj], ndigit, & '_sapps: occurred before shift number.') call psvout (comm, logfil, 1, h(i+1,1), ndigit, & '_sapps: the corresponding off diagonal element') @@ -443,7 +443,7 @@ big = abs(h(i,2)) + abs(h(i+1,2)) if (h(i+1,1) .le. epsmch*big) then if (msglvl .gt. 0) then - call pivout (comm, logfil, 1, i, ndigit, + call pivout (comm, logfil, 1, [i], ndigit, & '_sapps: deflation at row/column no.') call psvout (comm, logfil, 1, h(i+1,1), ndigit, & '_sapps: the corresponding off diagonal element') diff -Nru arpack-3.7.0/PARPACK/SRC/BLACS/pssaup2.f arpack-3.8.0/PARPACK/SRC/BLACS/pssaup2.f --- arpack-3.7.0/PARPACK/SRC/BLACS/pssaup2.f 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/PARPACK/SRC/BLACS/pssaup2.f 2020-12-07 10:40:45.000000000 +0000 @@ -421,13 +421,13 @@ iter = iter + 1 c if (msglvl .gt. 0) then - call pivout (comm, logfil, 1, iter, ndigit, + call pivout (comm, logfil, 1, [iter], ndigit, & '_saup2: **** Start of major iteration number ****') end if if (msglvl .gt. 1) then - call pivout (comm, logfil, 1, nev, ndigit, + call pivout (comm, logfil, 1, [nev], ndigit, & '_saup2: The length of the current Lanczos factorization') - call pivout (comm, logfil, 1, np, ndigit, + call pivout (comm, logfil, 1, [np], ndigit, & '_saup2: Extend the Lanczos factorization by') end if c @@ -466,7 +466,7 @@ update = .false. c if (msglvl .gt. 1) then - call psvout (comm, logfil, 1, rnorm, ndigit, + call psvout (comm, logfil, 1, [rnorm], ndigit, & '_saup2: Current B-norm of residual for factorization') end if c @@ -716,7 +716,7 @@ end if c if (msglvl .gt. 0) then - call pivout (comm, logfil, 1, nconv, ndigit, + call pivout (comm, logfil, 1, [nconv], ndigit, & '_saup2: no. of "converged" Ritz values at this iter.') if (msglvl .gt. 1) then kp(1) = nev @@ -763,7 +763,7 @@ if (ishift .eq. 0) call scopy (np, workl, 1, ritz, 1) c if (msglvl .gt. 2) then - call pivout (comm, logfil, 1, np, ndigit, + call pivout (comm, logfil, 1, [np], ndigit, & '_saup2: The number of shifts to apply ') call psvout (comm, logfil, np, workl, ndigit, & '_saup2: shifts selected') @@ -831,7 +831,7 @@ 130 continue c if (msglvl .gt. 2) then - call psvout (comm, logfil, 1, rnorm, ndigit, + call psvout (comm, logfil, 1, [rnorm], ndigit, & '_saup2: B-norm of residual for NEV factorization') call psvout (comm, logfil, nev, h(1,2), ndigit, & '_saup2: main diagonal of compressed H matrix') diff -Nru arpack-3.7.0/PARPACK/SRC/BLACS/pssaupd.f arpack-3.8.0/PARPACK/SRC/BLACS/pssaupd.f --- arpack-3.7.0/PARPACK/SRC/BLACS/pssaupd.f 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/PARPACK/SRC/BLACS/pssaupd.f 2020-12-07 10:40:45.000000000 +0000 @@ -644,9 +644,9 @@ if (info .eq. 2) info = 3 c if (msglvl .gt. 0) then - call pivout (comm, logfil, 1, mxiter, ndigit, + call pivout (comm, logfil, 1, [mxiter], ndigit, & '_saupd: number of update iterations taken') - call pivout (comm, logfil, 1, np, ndigit, + call pivout (comm, logfil, 1, [np], ndigit, & '_saupd: number of "converged" Ritz values') call psvout (comm, logfil, np, workl(Ritz), ndigit, & '_saupd: final Ritz values') diff -Nru arpack-3.7.0/PARPACK/SRC/BLACS/psseupd.f arpack-3.8.0/PARPACK/SRC/BLACS/psseupd.f --- arpack-3.7.0/PARPACK/SRC/BLACS/psseupd.f 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/PARPACK/SRC/BLACS/psseupd.f 2020-12-07 10:40:45.000000000 +0000 @@ -523,9 +523,9 @@ c %-----------------------------------------------------------% c if (msglvl .gt. 2) then - call pivout(comm, logfil, 1, numcnv, ndigit, + call pivout(comm, logfil, 1, [numcnv], ndigit, & '_neupd: Number of specified eigenvalues') - call pivout(comm, logfil, 1, nconv, ndigit, + call pivout(comm, logfil, 1, [nconv], ndigit, & '_neupd: Number of "converged" eigenvalues') end if c diff -Nru arpack-3.7.0/PARPACK/SRC/BLACS/pssgets.f arpack-3.8.0/PARPACK/SRC/BLACS/pssgets.f --- arpack-3.7.0/PARPACK/SRC/BLACS/pssgets.f 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/PARPACK/SRC/BLACS/pssgets.f 2020-12-07 10:40:45.000000000 +0000 @@ -216,8 +216,8 @@ tsgets = tsgets + (t1 - t0) c if (msglvl .gt. 0) then - call pivout (comm, logfil, 1, kev, ndigit, '_sgets: KEV is') - call pivout (comm, logfil, 1, np, ndigit, '_sgets: NP is') + call pivout (comm, logfil, 1, [kev], ndigit, '_sgets: KEV is') + call pivout (comm, logfil, 1, [np], ndigit, '_sgets: NP is') call psvout (comm, logfil, kev+np, ritz, ndigit, & '_sgets: Eigenvalues of current H matrix') call psvout (comm, logfil, kev+np, bounds, ndigit, diff -Nru arpack-3.7.0/PARPACK/SRC/BLACS/pzgetv0.f arpack-3.8.0/PARPACK/SRC/BLACS/pzgetv0.f --- arpack-3.7.0/PARPACK/SRC/BLACS/pzgetv0.f 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/PARPACK/SRC/BLACS/pzgetv0.f 2020-12-07 10:40:45.000000000 +0000 @@ -406,9 +406,9 @@ c %--------------------------------------% c if (msglvl .gt. 2) then - call pdvout (comm, logfil, 1, rnorm0, ndigit, + call pdvout (comm, logfil, 1, [rnorm0], ndigit, & '_getv0: re-orthonalization ; rnorm0 is') - call pdvout (comm, logfil, 1, rnorm, ndigit, + call pdvout (comm, logfil, 1, [rnorm], ndigit, & '_getv0: re-orthonalization ; rnorm is') end if c @@ -440,7 +440,7 @@ c if (msglvl .gt. 0) then cnorm2 = dcmplx (rnorm,rzero) - call pzvout (comm, logfil, 1, cnorm2, ndigit, + call pzvout (comm, logfil, 1, [cnorm2], ndigit, & '_getv0: B-norm of initial / restarted starting vector') end if if (msglvl .gt. 2) then diff -Nru arpack-3.7.0/PARPACK/SRC/BLACS/pznaitr.f arpack-3.8.0/PARPACK/SRC/BLACS/pznaitr.f --- arpack-3.7.0/PARPACK/SRC/BLACS/pznaitr.f 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/PARPACK/SRC/BLACS/pznaitr.f 2020-12-07 10:40:45.000000000 +0000 @@ -401,9 +401,9 @@ 1000 continue c if (msglvl .gt. 1) then - call pivout (comm, logfil, 1, j, ndigit, + call pivout (comm, logfil, 1, [j], ndigit, & '_naitr: generating Arnoldi vector number') - call pzvout (comm, logfil, 1, rnorm, ndigit, + call pzvout (comm, logfil, 1, [rnorm], ndigit, & '_naitr: B-norm of the current residual is') end if c @@ -423,7 +423,7 @@ c %---------------------------------------------------% c if (msglvl .gt. 0) then - call pivout (comm, logfil, 1, j, ndigit, + call pivout (comm, logfil, 1, [j], ndigit, & '_naitr: ****** RESTART AT STEP ******') end if c @@ -757,7 +757,7 @@ end if c if (msglvl .gt. 0 .and. iter .gt. 0 ) then - call pivout (comm, logfil, 1, j, ndigit, + call pivout (comm, logfil, 1, [j], ndigit, & '_naitr: Iterative refinement for Arnoldi residual') if (msglvl .gt. 2) then rtemp(1) = rnorm diff -Nru arpack-3.7.0/PARPACK/SRC/BLACS/pznapps.f arpack-3.8.0/PARPACK/SRC/BLACS/pznapps.f --- arpack-3.7.0/PARPACK/SRC/BLACS/pznapps.f 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/PARPACK/SRC/BLACS/pznapps.f 2020-12-07 10:40:45.000000000 +0000 @@ -284,9 +284,9 @@ sigma = shift(jj) c if (msglvl .gt. 2 ) then - call pivout (comm, logfil, 1, jj, ndigit, + call pivout (comm, logfil, 1, [jj], ndigit, & '_napps: shift number.') - call pzvout (comm, logfil, 1, sigma, ndigit, + call pzvout (comm, logfil, 1, [sigma], ndigit, & '_napps: Value of the shift ') end if c @@ -307,9 +307,9 @@ if ( abs(dble(h(i+1,i))) & .le. max(ulp*tst1, smlnum) ) then if (msglvl .gt. 0) then - call pivout (comm, logfil, 1, i, ndigit, + call pivout (comm, logfil, 1, [i], ndigit, & '_napps: matrix splitting at row/column no.') - call pivout (comm, logfil, 1, jj, ndigit, + call pivout (comm, logfil, 1, [jj], ndigit, & '_napps: matrix splitting with shift number.') call pzvout (comm, logfil, 1, h(i+1,i), ndigit, & '_napps: off diagonal element.') @@ -323,9 +323,9 @@ 40 continue c if (msglvl .gt. 2) then - call pivout (comm, logfil, 1, istart, ndigit, + call pivout (comm, logfil, 1, [istart], ndigit, & '_napps: Start of current block ') - call pivout (comm, logfil, 1, iend, ndigit, + call pivout (comm, logfil, 1, [iend], ndigit, & '_napps: End of current block ') end if c @@ -501,7 +501,7 @@ & '_napps: sigmak = (e_{kev+p}^T*Q)*e_{kev}') call pzvout (comm, logfil, 1, h(kev+1,kev), ndigit, & '_napps: betak = e_{kev+1}^T*H*e_{kev}') - call pivout (comm, logfil, 1, kev, ndigit, + call pivout (comm, logfil, 1, [kev], ndigit, & '_napps: Order of the final Hessenberg matrix ') if (msglvl .gt. 2) then call pzmout (comm, logfil, kev, kev, h, ldh, ndigit, diff -Nru arpack-3.7.0/PARPACK/SRC/BLACS/pznaup2.f arpack-3.8.0/PARPACK/SRC/BLACS/pznaup2.f --- arpack-3.7.0/PARPACK/SRC/BLACS/pznaup2.f 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/PARPACK/SRC/BLACS/pznaup2.f 2020-12-07 10:40:45.000000000 +0000 @@ -398,7 +398,7 @@ iter = iter + 1 c if (msglvl .gt. 0) then - call pivout (comm, logfil, 1, iter, ndigit, + call pivout (comm, logfil, 1, [iter], ndigit, & '_naup2: **** Start of major iteration number ****') end if c @@ -411,9 +411,9 @@ np = kplusp - nev c if (msglvl .gt. 1) then - call pivout (comm, logfil, 1, nev, ndigit, + call pivout (comm, logfil, 1, [nev], ndigit, & '_naup2: The length of the current Arnoldi factorization') - call pivout (comm, logfil, 1, np, ndigit, + call pivout (comm, logfil, 1, [np], ndigit, & '_naup2: Extend the Arnoldi factorization by') end if c @@ -440,7 +440,7 @@ update = .false. c if (msglvl .gt. 1) then - call pdvout (comm, logfil, 1, rnorm, ndigit, + call pdvout (comm, logfil, 1, [rnorm], ndigit, & '_naup2: Corresponding B-norm of the residual') end if c @@ -671,7 +671,7 @@ end if c if (msglvl .gt. 0) then - call pivout (comm, logfil, 1, nconv, ndigit, + call pivout (comm, logfil, 1, [nconv], ndigit, & '_naup2: no. of "converged" Ritz values at this iter.') if (msglvl .gt. 1) then kp(1) = nev @@ -711,7 +711,7 @@ end if c if (msglvl .gt. 2) then - call pivout (comm, logfil, 1, np, ndigit, + call pivout (comm, logfil, 1, [np], ndigit, & '_naup2: The number of shifts to apply ') call pzvout (comm, logfil, np, ritz, ndigit, & '_naup2: values of the shifts') @@ -776,7 +776,7 @@ cnorm = .false. c if (msglvl .gt. 2) then - call pdvout (comm, logfil, 1, rnorm, ndigit, + call pdvout (comm, logfil, 1, [rnorm], ndigit, & '_naup2: B-norm of residual for compressed factorization') call pzmout (comm, logfil, nev, nev, h, ldh, ndigit, & '_naup2: Compressed upper Hessenberg matrix H') diff -Nru arpack-3.7.0/PARPACK/SRC/BLACS/pznaupd.f arpack-3.8.0/PARPACK/SRC/BLACS/pznaupd.f --- arpack-3.7.0/PARPACK/SRC/BLACS/pznaupd.f 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/PARPACK/SRC/BLACS/pznaupd.f 2020-12-07 10:40:45.000000000 +0000 @@ -618,9 +618,9 @@ if (info .eq. 2) info = 3 c if (msglvl .gt. 0) then - call pivout (comm, logfil, 1, mxiter, ndigit, + call pivout (comm, logfil, 1, [mxiter], ndigit, & '_naupd: Number of update iterations taken') - call pivout (comm, logfil, 1, np, ndigit, + call pivout (comm, logfil, 1, [np], ndigit, & '_naupd: Number of wanted "converged" Ritz values') call pzvout (comm, logfil, np, workl(ritz), ndigit, & '_naupd: The final Ritz values') diff -Nru arpack-3.7.0/PARPACK/SRC/BLACS/pzneupd.f arpack-3.8.0/PARPACK/SRC/BLACS/pzneupd.f --- arpack-3.7.0/PARPACK/SRC/BLACS/pzneupd.f 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/PARPACK/SRC/BLACS/pzneupd.f 2020-12-07 10:40:45.000000000 +0000 @@ -558,9 +558,9 @@ c %-----------------------------------------------------------% c if (msglvl .gt. 2) then - call pivout(comm, logfil, 1, numcnv, ndigit, + call pivout(comm, logfil, 1, [numcnv], ndigit, & '_neupd: Number of specified eigenvalues') - call pivout(comm, logfil, 1, nconv, ndigit, + call pivout(comm, logfil, 1, [nconv], ndigit, & '_neupd: Number of "converged" eigenvalues') end if c diff -Nru arpack-3.7.0/PARPACK/SRC/BLACS/pzngets.f arpack-3.8.0/PARPACK/SRC/BLACS/pzngets.f --- arpack-3.7.0/PARPACK/SRC/BLACS/pzngets.f 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/PARPACK/SRC/BLACS/pzngets.f 2020-12-07 10:40:45.000000000 +0000 @@ -177,8 +177,8 @@ tcgets = tcgets + (t1 - t0) c if (msglvl .gt. 0) then - call pivout (comm, logfil, 1, kev, ndigit, '_ngets: KEV is') - call pivout (comm, logfil, 1, np, ndigit, '_ngets: NP is') + call pivout (comm, logfil, 1, [kev], ndigit, '_ngets: KEV is') + call pivout (comm, logfil, 1, [np], ndigit, '_ngets: NP is') call pzvout (comm, logfil, kev+np, ritz, ndigit, & '_ngets: Eigenvalues of current H matrix ') call pzvout (comm, logfil, kev+np, bounds, ndigit, diff -Nru arpack-3.7.0/PARPACK/SRC/MPI/icbpcn.F90 arpack-3.8.0/PARPACK/SRC/MPI/icbpcn.F90 --- arpack-3.7.0/PARPACK/SRC/MPI/icbpcn.F90 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/PARPACK/SRC/MPI/icbpcn.F90 2020-12-07 10:40:45.000000000 +0000 @@ -5,26 +5,34 @@ bind(c, name="pcnaupd_c") use :: iso_c_binding implicit none -#include "arpackdef.h" - integer(kind=c_int), value, intent(in) :: comm - integer(kind=c_int), intent(inout) :: ido - character(kind=c_char), dimension(1), intent(in) :: bmat - integer(kind=c_int), value, intent(in) :: n +#include "arpackicb.h" + integer(kind=i_int), value, intent(in) :: comm + integer(kind=i_int), intent(inout) :: ido + character(kind=c_char), intent(in) :: bmat + integer(kind=i_int), value, intent(in) :: n character(kind=c_char), dimension(2), intent(in) :: which - integer(kind=c_int), value, intent(in) :: nev + integer(kind=i_int), value, intent(in) :: nev real(kind=c_float), value, intent(in) :: tol complex(kind=c_float_complex),dimension(n), intent(inout) :: resid - integer(kind=c_int), value, intent(in) :: ncv + integer(kind=i_int), value, intent(in) :: ncv complex(kind=c_float_complex),dimension(ldv, ncv),intent(out) :: v - integer(kind=c_int), value, intent(in) :: ldv - integer(kind=c_int), dimension(11), intent(inout) :: iparam - integer(kind=c_int), dimension(11), intent(out) :: ipntr + integer(kind=i_int), value, intent(in) :: ldv + integer(kind=i_int), dimension(11), intent(inout) :: iparam + integer(kind=i_int), dimension(14), intent(out) :: ipntr complex(kind=c_float_complex),dimension(3*n), intent(out) :: workd complex(kind=c_float_complex),dimension(lworkl), intent(out) :: workl - integer(kind=c_int), value, intent(in) :: lworkl + integer(kind=i_int), value, intent(in) :: lworkl complex(kind=c_float_complex),dimension(ncv), intent(out) :: rwork - integer(kind=c_int), intent(inout) :: info - call pcnaupd(comm, ido, bmat, n, which, nev, tol, resid, ncv, v, ldv,& + integer(kind=i_int), intent(inout) :: info + + character(len=2):: w + integer :: i + + do i =1,2 + w(i:i) = which(i) + end do + + call pcnaupd(comm, ido, bmat, n, w, nev, tol, resid, ncv, v, ldv,& iparam, ipntr, workd, workl, lworkl, rwork, info) end subroutine pcnaupd_c @@ -34,33 +42,56 @@ bind(c, name="pcneupd_c") use :: iso_c_binding implicit none -#include "arpackdef.h" - integer(kind=c_int), value, intent(in) :: comm - logical(kind=c_bool), value, intent(in) :: rvec - character(kind=c_char), dimension(1), intent(in) :: howmny - logical(kind=c_bool), dimension(ncv), intent(in) :: select +#include "arpackicb.h" + integer(kind=i_int), value, intent(in) :: comm + integer(kind=i_int), value, intent(in) :: rvec + character(kind=c_char), intent(in) :: howmny + integer(kind=i_int), dimension(ncv), intent(in) :: select complex(kind=c_float_complex),dimension(nev), intent(out) :: d complex(kind=c_float_complex),dimension(n, nev), intent(out) :: z - integer(kind=c_int), value, intent(in) :: ldz + integer(kind=i_int), value, intent(in) :: ldz complex(kind=c_float_complex),value, intent(in) :: sigma complex(kind=c_float_complex),dimension(2*ncv), intent(out) :: workev - character(kind=c_char), dimension(1), intent(in) :: bmat - integer(kind=c_int), value, intent(in) :: n + character(kind=c_char), intent(in) :: bmat + integer(kind=i_int), value, intent(in) :: n character(kind=c_char), dimension(2), intent(in) :: which - integer(kind=c_int), value, intent(in) :: nev + integer(kind=i_int), value, intent(in) :: nev real(kind=c_float), value, intent(in) :: tol complex(kind=c_float_complex),dimension(n), intent(inout) :: resid - integer(kind=c_int), value, intent(in) :: ncv + integer(kind=i_int), value, intent(in) :: ncv complex(kind=c_float_complex),dimension(ldv, ncv),intent(out) :: v - integer(kind=c_int), value, intent(in) :: ldv - integer(kind=c_int), dimension(11), intent(inout) :: iparam - integer(kind=c_int), dimension(11), intent(out) :: ipntr + integer(kind=i_int), value, intent(in) :: ldv + integer(kind=i_int), dimension(11), intent(inout) :: iparam + integer(kind=i_int), dimension(14), intent(out) :: ipntr complex(kind=c_float_complex),dimension(3*n), intent(out) :: workd complex(kind=c_float_complex),dimension(lworkl), intent(out) :: workl - integer(kind=c_int), value, intent(in) :: lworkl + integer(kind=i_int), value, intent(in) :: lworkl complex(kind=c_float_complex),dimension(ncv), intent(out) :: rwork - integer(kind=c_int), intent(inout) :: info - call pcneupd(comm, rvec, howmny, select, d, z, ldz, sigma, workev,& - bmat, n, which, nev, tol, resid, ncv, v, ldv, & + integer(kind=i_int), intent(inout) :: info + + ! convert parameters if needed. + + logical :: rv + logical, dimension(ncv) :: slt + integer :: idx + character(len=2):: w + integer :: i + + rv = .false. + if (rvec .ne. 0) rv = .true. + + slt = .false. + do idx=1, ncv + if (select(idx) .ne. 0) slt(idx) = .true. + enddo + + do i =1,2 + w(i:i) = which(i) + end do + + ! call arpack. + + call pcneupd(comm, rv, howmny, slt, d, z, ldz, sigma, workev,& + bmat, n, w, nev, tol, resid, ncv, v, ldv, & iparam, ipntr, workd, workl, lworkl, rwork, info) end subroutine pcneupd_c diff -Nru arpack-3.7.0/PARPACK/SRC/MPI/icbpdn.F90 arpack-3.8.0/PARPACK/SRC/MPI/icbpdn.F90 --- arpack-3.7.0/PARPACK/SRC/MPI/icbpdn.F90 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/PARPACK/SRC/MPI/icbpdn.F90 2020-12-07 10:40:45.000000000 +0000 @@ -5,25 +5,33 @@ bind(c, name="pdnaupd_c") use :: iso_c_binding implicit none -#include "arpackdef.h" - integer(kind=c_int), value, intent(in) :: comm - integer(kind=c_int), intent(inout) :: ido - character(kind=c_char), dimension(1), intent(in) :: bmat - integer(kind=c_int), value, intent(in) :: n +#include "arpackicb.h" + integer(kind=i_int), value, intent(in) :: comm + integer(kind=i_int), intent(inout) :: ido + character(kind=c_char), intent(in) :: bmat + integer(kind=i_int), value, intent(in) :: n character(kind=c_char), dimension(2), intent(in) :: which - integer(kind=c_int), value, intent(in) :: nev + integer(kind=i_int), value, intent(in) :: nev real(kind=c_double), value, intent(in) :: tol real(kind=c_double), dimension(n), intent(inout) :: resid - integer(kind=c_int), value, intent(in) :: ncv + integer(kind=i_int), value, intent(in) :: ncv real(kind=c_double), dimension(ldv, ncv), intent(out) :: v - integer(kind=c_int), value, intent(in) :: ldv - integer(kind=c_int), dimension(11), intent(inout) :: iparam - integer(kind=c_int), dimension(11), intent(out) :: ipntr + integer(kind=i_int), value, intent(in) :: ldv + integer(kind=i_int), dimension(11), intent(inout) :: iparam + integer(kind=i_int), dimension(14), intent(out) :: ipntr real(kind=c_double), dimension(3*n), intent(out) :: workd real(kind=c_double), dimension(lworkl), intent(out) :: workl - integer(kind=c_int), value, intent(in) :: lworkl - integer(kind=c_int), intent(inout) :: info - call pdnaupd(comm, ido, bmat, n, which, nev, tol, resid, ncv, v, ldv,& + integer(kind=i_int), value, intent(in) :: lworkl + integer(kind=i_int), intent(inout) :: info + + character(len=2):: w + integer :: i + + do i =1,2 + w(i:i) = which(i) + end do + + call pdnaupd(comm, ido, bmat, n, w, nev, tol, resid, ncv, v, ldv,& iparam, ipntr, workd, workl, lworkl, info) end subroutine pdnaupd_c @@ -34,35 +42,58 @@ bind(c, name="pdneupd_c") use :: iso_c_binding implicit none -#include "arpackdef.h" - integer(kind=c_int), value, intent(in) :: comm - logical(kind=c_bool), value, intent(in) :: rvec - character(kind=c_char), dimension(1), intent(in) :: howmny - logical(kind=c_bool), dimension(ncv), intent(in) :: select +#include "arpackicb.h" + integer(kind=i_int), value, intent(in) :: comm + integer(kind=i_int), value, intent(in) :: rvec + character(kind=c_char), intent(in) :: howmny + integer(kind=i_int), dimension(ncv), intent(in) :: select real(kind=c_double), dimension(nev+1), intent(out) :: dr real(kind=c_double), dimension(nev+1), intent(out) :: di real(kind=c_double), dimension(n, nev+1), intent(out) :: z - integer(kind=c_int), value, intent(in) :: ldz + integer(kind=i_int), value, intent(in) :: ldz real(kind=c_double), value, intent(in) :: sigmar real(kind=c_double), value, intent(in) :: sigmai real(kind=c_double), dimension(3*ncv), intent(out) :: workev - character(kind=c_char), dimension(1), intent(in) :: bmat - integer(kind=c_int), value, intent(in) :: n + character(kind=c_char), intent(in) :: bmat + integer(kind=i_int), value, intent(in) :: n character(kind=c_char), dimension(2), intent(in) :: which - integer(kind=c_int), value, intent(in) :: nev + integer(kind=i_int), value, intent(in) :: nev real(kind=c_double), value, intent(in) :: tol real(kind=c_double), dimension(n), intent(inout) :: resid - integer(kind=c_int), value, intent(in) :: ncv + integer(kind=i_int), value, intent(in) :: ncv real(kind=c_double), dimension(ldv, ncv), intent(out) :: v - integer(kind=c_int), value, intent(in) :: ldv - integer(kind=c_int), dimension(11), intent(inout) :: iparam - integer(kind=c_int), dimension(11), intent(out) :: ipntr + integer(kind=i_int), value, intent(in) :: ldv + integer(kind=i_int), dimension(11), intent(inout) :: iparam + integer(kind=i_int), dimension(14), intent(out) :: ipntr real(kind=c_double), dimension(3*n), intent(out) :: workd real(kind=c_double), dimension(lworkl), intent(out) :: workl - integer(kind=c_int), value, intent(in) :: lworkl - integer(kind=c_int), intent(inout) :: info - call pdneupd(comm, rvec, howmny, select, & + integer(kind=i_int), value, intent(in) :: lworkl + integer(kind=i_int), intent(inout) :: info + + ! convert parameters if needed. + + logical :: rv + logical, dimension(ncv) :: slt + integer :: idx + character(len=2):: w + integer :: i + + rv = .false. + if (rvec .ne. 0) rv = .true. + + slt = .false. + do idx=1, ncv + if (select(idx) .ne. 0) slt(idx) = .true. + enddo + + do i =1,2 + w(i:i) = which(i) + end do + + ! call arpack. + + call pdneupd(comm, rv, howmny, slt, & dr, di, z, ldz, sigmar, sigmai, workev, & - bmat, n, which, nev, tol, resid, ncv, v, ldv,& + bmat, n, w, nev, tol, resid, ncv, v, ldv,& iparam, ipntr, workd, workl, lworkl, info) end subroutine pdneupd_c diff -Nru arpack-3.7.0/PARPACK/SRC/MPI/icbpds.F90 arpack-3.8.0/PARPACK/SRC/MPI/icbpds.F90 --- arpack-3.7.0/PARPACK/SRC/MPI/icbpds.F90 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/PARPACK/SRC/MPI/icbpds.F90 2020-12-07 10:40:45.000000000 +0000 @@ -5,25 +5,33 @@ bind(c, name="pdsaupd_c") use :: iso_c_binding implicit none -#include "arpackdef.h" - integer(kind=c_int), value, intent(in) :: comm - integer(kind=c_int), intent(inout) :: ido - character(kind=c_char), dimension(1), intent(in) :: bmat - integer(kind=c_int), value, intent(in) :: n +#include "arpackicb.h" + integer(kind=i_int), value, intent(in) :: comm + integer(kind=i_int), intent(inout) :: ido + character(kind=c_char), intent(in) :: bmat + integer(kind=i_int), value, intent(in) :: n character(kind=c_char), dimension(2), intent(in) :: which - integer(kind=c_int), value, intent(in) :: nev + integer(kind=i_int), value, intent(in) :: nev real(kind=c_double), value, intent(in) :: tol real(kind=c_double), dimension(n), intent(inout) :: resid - integer(kind=c_int), value, intent(in) :: ncv + integer(kind=i_int), value, intent(in) :: ncv real(kind=c_double), dimension(ldv, ncv), intent(out) :: v - integer(kind=c_int), value, intent(in) :: ldv - integer(kind=c_int), dimension(11), intent(inout) :: iparam - integer(kind=c_int), dimension(11), intent(out) :: ipntr + integer(kind=i_int), value, intent(in) :: ldv + integer(kind=i_int), dimension(11), intent(inout) :: iparam + integer(kind=i_int), dimension(11), intent(out) :: ipntr real(kind=c_double), dimension(3*n), intent(out) :: workd real(kind=c_double), dimension(lworkl), intent(out) :: workl - integer(kind=c_int), value, intent(in) :: lworkl - integer(kind=c_int), intent(inout) :: info - call pdsaupd(comm, ido, bmat, n, which, nev, tol, resid, ncv, v, ldv,& + integer(kind=i_int), value, intent(in) :: lworkl + integer(kind=i_int), intent(inout) :: info + + character(len=2):: w + integer :: i + + do i =1,2 + w(i:i) = which(i) + end do + + call pdsaupd(comm, ido, bmat, n, w, nev, tol, resid, ncv, v, ldv,& iparam, ipntr, workd, workl, lworkl, info) end subroutine pdsaupd_c @@ -33,31 +41,54 @@ bind(c, name="pdseupd_c") use :: iso_c_binding implicit none -#include "arpackdef.h" - integer(kind=c_int), value, intent(in) :: comm - logical(kind=c_bool), value, intent(in) :: rvec - character(kind=c_char), dimension(1), intent(in) :: howmny - logical(kind=c_bool), dimension(ncv), intent(in) :: select +#include "arpackicb.h" + integer(kind=i_int), value, intent(in) :: comm + integer(kind=i_int), value, intent(in) :: rvec + character(kind=c_char), intent(in) :: howmny + integer(kind=i_int), dimension(ncv), intent(in) :: select real(kind=c_double), dimension(nev), intent(out) :: d real(kind=c_double), dimension(n, nev), intent(out) :: z - integer(kind=c_int), value, intent(in) :: ldz + integer(kind=i_int), value, intent(in) :: ldz real(kind=c_double), value, intent(in) :: sigma - character(kind=c_char), dimension(1), intent(in) :: bmat - integer(kind=c_int), value, intent(in) :: n + character(kind=c_char), intent(in) :: bmat + integer(kind=i_int), value, intent(in) :: n character(kind=c_char), dimension(2), intent(in) :: which - integer(kind=c_int), value, intent(in) :: nev + integer(kind=i_int), value, intent(in) :: nev real(kind=c_double), value, intent(in) :: tol real(kind=c_double), dimension(n), intent(inout) :: resid - integer(kind=c_int), value, intent(in) :: ncv + integer(kind=i_int), value, intent(in) :: ncv real(kind=c_double), dimension(ldv, ncv), intent(out) :: v - integer(kind=c_int), value, intent(in) :: ldv - integer(kind=c_int), dimension(11), intent(inout) :: iparam - integer(kind=c_int), dimension(11), intent(out) :: ipntr + integer(kind=i_int), value, intent(in) :: ldv + integer(kind=i_int), dimension(7), intent(inout) :: iparam + integer(kind=i_int), dimension(11), intent(out) :: ipntr real(kind=c_double), dimension(3*n), intent(out) :: workd real(kind=c_double), dimension(lworkl), intent(out) :: workl - integer(kind=c_int), value, intent(in) :: lworkl - integer(kind=c_int), intent(inout) :: info - call pdseupd(comm, rvec, howmny, select, d, z, ldz, sigma,& - bmat, n, which, nev, tol, resid, ncv, v, ldv,& + integer(kind=i_int), value, intent(in) :: lworkl + integer(kind=i_int), intent(inout) :: info + + ! convert parameters if needed. + + logical :: rv + logical, dimension(ncv) :: slt + integer :: idx + character(len=2):: w + integer :: i + + rv = .false. + if (rvec .ne. 0) rv = .true. + + slt = .false. + do idx=1, ncv + if (select(idx) .ne. 0) slt(idx) = .true. + enddo + + do i =1,2 + w(i:i) = which(i) + end do + + ! call arpack. + + call pdseupd(comm, rv, howmny, slt, d, z, ldz, sigma, & + bmat, n, w, nev, tol, resid, ncv, v, ldv,& iparam, ipntr, workd, workl, lworkl, info) end subroutine pdseupd_c diff -Nru arpack-3.7.0/PARPACK/SRC/MPI/icbpsn.F90 arpack-3.8.0/PARPACK/SRC/MPI/icbpsn.F90 --- arpack-3.7.0/PARPACK/SRC/MPI/icbpsn.F90 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/PARPACK/SRC/MPI/icbpsn.F90 2020-12-07 10:40:45.000000000 +0000 @@ -5,25 +5,33 @@ bind(c, name="psnaupd_c") use :: iso_c_binding implicit none -#include "arpackdef.h" - integer(kind=c_int), value, intent(in) :: comm - integer(kind=c_int), intent(inout) :: ido - character(kind=c_char), dimension(1), intent(in) :: bmat - integer(kind=c_int), value, intent(in) :: n +#include "arpackicb.h" + integer(kind=i_int), value, intent(in) :: comm + integer(kind=i_int), intent(inout) :: ido + character(kind=c_char), intent(in) :: bmat + integer(kind=i_int), value, intent(in) :: n character(kind=c_char), dimension(2), intent(in) :: which - integer(kind=c_int), value, intent(in) :: nev + integer(kind=i_int), value, intent(in) :: nev real(kind=c_float), value, intent(in) :: tol real(kind=c_float), dimension(n), intent(inout) :: resid - integer(kind=c_int), value, intent(in) :: ncv + integer(kind=i_int), value, intent(in) :: ncv real(kind=c_float), dimension(ldv, ncv), intent(out) :: v - integer(kind=c_int), value, intent(in) :: ldv - integer(kind=c_int), dimension(11), intent(inout) :: iparam - integer(kind=c_int), dimension(11), intent(out) :: ipntr + integer(kind=i_int), value, intent(in) :: ldv + integer(kind=i_int), dimension(11), intent(inout) :: iparam + integer(kind=i_int), dimension(14), intent(out) :: ipntr real(kind=c_float), dimension(3*n), intent(out) :: workd real(kind=c_float), dimension(lworkl), intent(out) :: workl - integer(kind=c_int), value, intent(in) :: lworkl - integer(kind=c_int), intent(inout) :: info - call psnaupd(comm, ido, bmat, n, which, nev, tol, resid, ncv, v, ldv,& + integer(kind=i_int), value, intent(in) :: lworkl + integer(kind=i_int), intent(inout) :: info + + character(len=2):: w + integer :: i + + do i =1,2 + w(i:i) = which(i) + end do + + call psnaupd(comm, ido, bmat, n, w, nev, tol, resid, ncv, v, ldv,& iparam, ipntr, workd, workl, lworkl, info) end subroutine psnaupd_c @@ -34,35 +42,58 @@ bind(c, name="psneupd_c") use :: iso_c_binding implicit none -#include "arpackdef.h" - integer(kind=c_int), value, intent(in) :: comm - logical(kind=c_bool), value, intent(in) :: rvec - character(kind=c_char), dimension(1), intent(in) :: howmny - logical(kind=c_bool), dimension(ncv), intent(in) :: select +#include "arpackicb.h" + integer(kind=i_int), value, intent(in) :: comm + integer(kind=i_int), value, intent(in) :: rvec + character(kind=c_char), intent(in) :: howmny + integer(kind=i_int), dimension(ncv), intent(in) :: select real(kind=c_float), dimension(nev+1), intent(out) :: dr real(kind=c_float), dimension(nev+1), intent(out) :: di real(kind=c_float), dimension(n, nev+1), intent(out) :: z - integer(kind=c_int), value, intent(in) :: ldz + integer(kind=i_int), value, intent(in) :: ldz real(kind=c_float), value, intent(in) :: sigmar real(kind=c_float), value, intent(in) :: sigmai real(kind=c_float), dimension(3*ncv), intent(out) :: workev - character(kind=c_char), dimension(1), intent(in) :: bmat - integer(kind=c_int), value, intent(in) :: n + character(kind=c_char), intent(in) :: bmat + integer(kind=i_int), value, intent(in) :: n character(kind=c_char), dimension(2), intent(in) :: which - integer(kind=c_int), value, intent(in) :: nev + integer(kind=i_int), value, intent(in) :: nev real(kind=c_float), value, intent(in) :: tol real(kind=c_float), dimension(n), intent(inout) :: resid - integer(kind=c_int), value, intent(in) :: ncv + integer(kind=i_int), value, intent(in) :: ncv real(kind=c_float), dimension(ldv, ncv), intent(out) :: v - integer(kind=c_int), value, intent(in) :: ldv - integer(kind=c_int), dimension(11), intent(inout) :: iparam - integer(kind=c_int), dimension(11), intent(out) :: ipntr + integer(kind=i_int), value, intent(in) :: ldv + integer(kind=i_int), dimension(11), intent(inout) :: iparam + integer(kind=i_int), dimension(14), intent(out) :: ipntr real(kind=c_float), dimension(3*n), intent(out) :: workd real(kind=c_float), dimension(lworkl), intent(out) :: workl - integer(kind=c_int), value, intent(in) :: lworkl - integer(kind=c_int), intent(inout) :: info - call psneupd(comm, rvec, howmny, select, & + integer(kind=i_int), value, intent(in) :: lworkl + integer(kind=i_int), intent(inout) :: info + + ! convert parameters if needed. + + logical :: rv + logical, dimension(ncv) :: slt + integer :: idx + character(len=2):: w + integer :: i + + rv = .false. + if (rvec .ne. 0) rv = .true. + + slt = .false. + do idx=1, ncv + if (select(idx) .ne. 0) slt(idx) = .true. + enddo + + do i =1,2 + w(i:i) = which(i) + end do + + ! call arpack. + + call psneupd(comm, rv, howmny, slt, & dr, di, z, ldz, sigmar, sigmai, workev, & - bmat, n, which, nev, tol, resid, ncv, v, ldv,& + bmat, n, w, nev, tol, resid, ncv, v, ldv,& iparam, ipntr, workd, workl, lworkl, info) end subroutine psneupd_c diff -Nru arpack-3.7.0/PARPACK/SRC/MPI/icbpss.F90 arpack-3.8.0/PARPACK/SRC/MPI/icbpss.F90 --- arpack-3.7.0/PARPACK/SRC/MPI/icbpss.F90 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/PARPACK/SRC/MPI/icbpss.F90 2020-12-07 10:40:45.000000000 +0000 @@ -5,25 +5,33 @@ bind(c, name="pssaupd_c") use :: iso_c_binding implicit none -#include "arpackdef.h" - integer(kind=c_int), value, intent(in) :: comm - integer(kind=c_int), intent(inout) :: ido - character(kind=c_char), dimension(1), intent(in) :: bmat - integer(kind=c_int), value, intent(in) :: n +#include "arpackicb.h" + integer(kind=i_int), value, intent(in) :: comm + integer(kind=i_int), intent(inout) :: ido + character(kind=c_char), intent(in) :: bmat + integer(kind=i_int), value, intent(in) :: n character(kind=c_char), dimension(2), intent(in) :: which - integer(kind=c_int), value, intent(in) :: nev + integer(kind=i_int), value, intent(in) :: nev real(kind=c_float), value, intent(in) :: tol real(kind=c_float), dimension(n), intent(inout) :: resid - integer(kind=c_int), value, intent(in) :: ncv + integer(kind=i_int), value, intent(in) :: ncv real(kind=c_float), dimension(ldv, ncv), intent(out) :: v - integer(kind=c_int), value, intent(in) :: ldv - integer(kind=c_int), dimension(11), intent(inout) :: iparam - integer(kind=c_int), dimension(11), intent(out) :: ipntr + integer(kind=i_int), value, intent(in) :: ldv + integer(kind=i_int), dimension(11), intent(inout) :: iparam + integer(kind=i_int), dimension(11), intent(out) :: ipntr real(kind=c_float), dimension(3*n), intent(out) :: workd real(kind=c_float), dimension(lworkl), intent(out) :: workl - integer(kind=c_int), value, intent(in) :: lworkl - integer(kind=c_int), intent(inout) :: info - call pssaupd(comm, ido, bmat, n, which, nev, tol, resid, ncv, v, ldv,& + integer(kind=i_int), value, intent(in) :: lworkl + integer(kind=i_int), intent(inout) :: info + + character(len=2):: w + integer :: i + + do i =1,2 + w(i:i) = which(i) + end do + + call pssaupd(comm, ido, bmat, n, w, nev, tol, resid, ncv, v, ldv,& iparam, ipntr, workd, workl, lworkl, info) end subroutine pssaupd_c @@ -33,31 +41,54 @@ bind(c, name="psseupd_c") use :: iso_c_binding implicit none -#include "arpackdef.h" - integer(kind=c_int), value, intent(in) :: comm - logical(kind=c_bool), value, intent(in) :: rvec - character(kind=c_char), dimension(1), intent(in) :: howmny - logical(kind=c_bool), dimension(ncv), intent(in) :: select +#include "arpackicb.h" + integer(kind=i_int), value, intent(in) :: comm + integer(kind=i_int), value, intent(in) :: rvec + character(kind=c_char), intent(in) :: howmny + integer(kind=i_int), dimension(ncv), intent(in) :: select real(kind=c_float), dimension(nev), intent(out) :: d real(kind=c_float), dimension(n, nev), intent(out) :: z - integer(kind=c_int), value, intent(in) :: ldz + integer(kind=i_int), value, intent(in) :: ldz real(kind=c_float), value, intent(in) :: sigma - character(kind=c_char), dimension(1), intent(in) :: bmat - integer(kind=c_int), value, intent(in) :: n + character(kind=c_char), intent(in) :: bmat + integer(kind=i_int), value, intent(in) :: n character(kind=c_char), dimension(2), intent(in) :: which - integer(kind=c_int), value, intent(in) :: nev + integer(kind=i_int), value, intent(in) :: nev real(kind=c_float), value, intent(in) :: tol real(kind=c_float), dimension(n), intent(inout) :: resid - integer(kind=c_int), value, intent(in) :: ncv + integer(kind=i_int), value, intent(in) :: ncv real(kind=c_float), dimension(ldv, ncv), intent(out) :: v - integer(kind=c_int), value, intent(in) :: ldv - integer(kind=c_int), dimension(11), intent(inout) :: iparam - integer(kind=c_int), dimension(11), intent(out) :: ipntr + integer(kind=i_int), value, intent(in) :: ldv + integer(kind=i_int), dimension(7), intent(inout) :: iparam + integer(kind=i_int), dimension(11), intent(out) :: ipntr real(kind=c_float), dimension(3*n), intent(out) :: workd real(kind=c_float), dimension(lworkl), intent(out) :: workl - integer(kind=c_int), value, intent(in) :: lworkl - integer(kind=c_int), intent(inout) :: info - call psseupd(comm, rvec, howmny, select, d, z, ldz, sigma,& - bmat, n, which, nev, tol, resid, ncv, v, ldv,& + integer(kind=i_int), value, intent(in) :: lworkl + integer(kind=i_int), intent(inout) :: info + + ! convert parameters if needed. + + logical :: rv + logical, dimension(ncv) :: slt + integer :: idx + character(len=2):: w + integer :: i + + rv = .false. + if (rvec .ne. 0) rv = .true. + + slt = .false. + do idx=1, ncv + if (select(idx) .ne. 0) slt(idx) = .true. + enddo + + do i =1,2 + w(i:i) = which(i) + end do + + ! call arpack. + + call psseupd(comm, rv, howmny, slt, d, z, ldz, sigma, & + bmat, n, w, nev, tol, resid, ncv, v, ldv,& iparam, ipntr, workd, workl, lworkl, info) end subroutine psseupd_c diff -Nru arpack-3.7.0/PARPACK/SRC/MPI/icbpzn.F90 arpack-3.8.0/PARPACK/SRC/MPI/icbpzn.F90 --- arpack-3.7.0/PARPACK/SRC/MPI/icbpzn.F90 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/PARPACK/SRC/MPI/icbpzn.F90 2020-12-07 10:40:45.000000000 +0000 @@ -5,26 +5,34 @@ bind(c, name="pznaupd_c") use :: iso_c_binding implicit none -#include "arpackdef.h" - integer(kind=c_int), value, intent(in) :: comm - integer(kind=c_int), intent(inout) :: ido - character(kind=c_char), dimension(1), intent(in) :: bmat - integer(kind=c_int), value, intent(in) :: n +#include "arpackicb.h" + integer(kind=i_int), value, intent(in) :: comm + integer(kind=i_int), intent(inout) :: ido + character(kind=c_char), intent(in) :: bmat + integer(kind=i_int), value, intent(in) :: n character(kind=c_char), dimension(2), intent(in) :: which - integer(kind=c_int), value, intent(in) :: nev + integer(kind=i_int), value, intent(in) :: nev real(kind=c_double), value, intent(in) :: tol complex(kind=c_double_complex), dimension(n), intent(inout) :: resid - integer(kind=c_int), value, intent(in) :: ncv + integer(kind=i_int), value, intent(in) :: ncv complex(kind=c_double_complex), dimension(ldv, ncv),intent(out) :: v - integer(kind=c_int), value, intent(in) :: ldv - integer(kind=c_int), dimension(11), intent(inout) :: iparam - integer(kind=c_int), dimension(11), intent(out) :: ipntr + integer(kind=i_int), value, intent(in) :: ldv + integer(kind=i_int), dimension(11), intent(inout) :: iparam + integer(kind=i_int), dimension(14), intent(out) :: ipntr complex(kind=c_double_complex), dimension(3*n), intent(out) :: workd complex(kind=c_double_complex), dimension(lworkl), intent(out) :: workl - integer(kind=c_int), value, intent(in) :: lworkl + integer(kind=i_int), value, intent(in) :: lworkl complex(kind=c_double_complex), dimension(ncv), intent(out) :: rwork - integer(kind=c_int), intent(inout) :: info - call pznaupd(comm, ido, bmat, n, which, nev, tol, resid, ncv, v, ldv,& + integer(kind=i_int), intent(inout) :: info + + character(len=2):: w + integer :: i + + do i =1,2 + w(i:i) = which(i) + end do + + call pznaupd(comm, ido, bmat, n, w, nev, tol, resid, ncv, v, ldv,& iparam, ipntr, workd, workl, lworkl, rwork, info) end subroutine pznaupd_c @@ -34,33 +42,56 @@ bind(c, name="pzneupd_c") use :: iso_c_binding implicit none -#include "arpackdef.h" - integer(kind=c_int), value, intent(in) :: comm - logical(kind=c_bool), value, intent(in) :: rvec - character(kind=c_char), dimension(1), intent(in) :: howmny - logical(kind=c_bool), dimension(ncv), intent(in) :: select +#include "arpackicb.h" + integer(kind=i_int), value, intent(in) :: comm + integer(kind=i_int), value, intent(in) :: rvec + character(kind=c_char), intent(in) :: howmny + integer(kind=i_int), dimension(ncv), intent(in) :: select complex(kind=c_double_complex), dimension(nev), intent(out) :: d complex(kind=c_double_complex), dimension(n, nev), intent(out) :: z - integer(kind=c_int), value, intent(in) :: ldz + integer(kind=i_int), value, intent(in) :: ldz complex(kind=c_double_complex), value, intent(in) :: sigma complex(kind=c_double_complex), dimension(2*ncv), intent(out) :: workev - character(kind=c_char), dimension(1), intent(in) :: bmat - integer(kind=c_int), value, intent(in) :: n + character(kind=c_char), intent(in) :: bmat + integer(kind=i_int), value, intent(in) :: n character(kind=c_char), dimension(2), intent(in) :: which - integer(kind=c_int), value, intent(in) :: nev + integer(kind=i_int), value, intent(in) :: nev real(kind=c_double), value, intent(in) :: tol complex(kind=c_double_complex), dimension(n), intent(inout) :: resid - integer(kind=c_int), value, intent(in) :: ncv + integer(kind=i_int), value, intent(in) :: ncv complex(kind=c_double_complex), dimension(ldv, ncv),intent(out) :: v - integer(kind=c_int), value, intent(in) :: ldv - integer(kind=c_int), dimension(11), intent(inout) :: iparam - integer(kind=c_int), dimension(11), intent(out) :: ipntr + integer(kind=i_int), value, intent(in) :: ldv + integer(kind=i_int), dimension(11), intent(inout) :: iparam + integer(kind=i_int), dimension(14), intent(out) :: ipntr complex(kind=c_double_complex), dimension(3*n), intent(out) :: workd complex(kind=c_double_complex), dimension(lworkl), intent(out) :: workl - integer(kind=c_int), value, intent(in) :: lworkl + integer(kind=i_int), value, intent(in) :: lworkl complex(kind=c_double_complex), dimension(ncv), intent(out) :: rwork - integer(kind=c_int), intent(inout) :: info - call pzneupd(comm, rvec, howmny, select, d, z, ldz, sigma, workev,& - bmat, n, which, nev, tol, resid, ncv, v, ldv, & + integer(kind=i_int), intent(inout) :: info + + ! convert parameters if needed. + + logical :: rv + logical, dimension(ncv) :: slt + integer :: idx + character(len=2):: w + integer :: i + + rv = .false. + if (rvec .ne. 0) rv = .true. + + slt = .false. + do idx=1, ncv + if (select(idx) .ne. 0) slt(idx) = .true. + enddo + + do i =1,2 + w(i:i) = which(i) + end do + + ! call arpack. + + call pzneupd(comm, rv, howmny, slt, d, z, ldz, sigma, workev,& + bmat, n, w, nev, tol, resid, ncv, v, ldv, & iparam, ipntr, workd, workl, lworkl, rwork, info) end subroutine pzneupd_c diff -Nru arpack-3.7.0/PARPACK/SRC/MPI/Makefile.am arpack-3.8.0/PARPACK/SRC/MPI/Makefile.am --- arpack-3.7.0/PARPACK/SRC/MPI/Makefile.am 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/PARPACK/SRC/MPI/Makefile.am 2020-12-07 10:40:45.000000000 +0000 @@ -46,3 +46,8 @@ libparpack@LIBSUFFIX@_la_LIBADD += $(top_builddir)/ICB/libdbgicb.la $(top_builddir)/ICB/libstaicb.la libparpack@LIBSUFFIX@_la_CPPFLAGS = $(AM_CPPFLAGS) -I$(top_builddir) endif + +pkgconfig_DATA = parpack@LIBSUFFIX@.pc + +# Due to the LIBSUFFIX, configure doesn't automatically clean this file: +DISTCLEANFILES = parpack@LIBSUFFIX@.pc diff -Nru arpack-3.7.0/PARPACK/SRC/MPI/parpack.pc.in arpack-3.8.0/PARPACK/SRC/MPI/parpack.pc.in --- arpack-3.7.0/PARPACK/SRC/MPI/parpack.pc.in 1970-01-01 00:00:00.000000000 +0000 +++ arpack-3.8.0/PARPACK/SRC/MPI/parpack.pc.in 2020-12-07 10:40:45.000000000 +0000 @@ -0,0 +1,11 @@ +prefix=@prefix@ +exec_prefix=@exec_prefix@ +libdir=@libdir@ + +Name: @PACKAGE_NAME@ +Description: Collection of Fortran77 subroutines designed to solve large scale eigenvalue problems +Version: @PACKAGE_VERSION@ +URL: @PACKAGE_URL@ +Requires.private: arpack@LIBSUFFIX@ +Libs: -L${libdir} -lparpack@LIBSUFFIX@ +Libs.private: @PARPACK_PC_LIBS_PRIVATE@ diff -Nru arpack-3.7.0/PARPACK/SRC/MPI/pcgetv0.f arpack-3.8.0/PARPACK/SRC/MPI/pcgetv0.f --- arpack-3.7.0/PARPACK/SRC/MPI/pcgetv0.f 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/PARPACK/SRC/MPI/pcgetv0.f 2020-12-07 10:40:45.000000000 +0000 @@ -185,7 +185,7 @@ save first, iseed, inits, iter, msglvl, orth, rnorm0 c Complex - & cnorm_buf + & cnorm_buf, buf2(1) c c %----------------------% c | External Subroutines | @@ -332,8 +332,9 @@ first = .FALSE. if (bmat .eq. 'G') then cnorm_buf = cdotc (n, resid, 1, workd, 1) - call MPI_ALLREDUCE( cnorm_buf, cnorm, 1, + call MPI_ALLREDUCE( [cnorm_buf], buf2, 1, & MPI_COMPLEX, MPI_SUM, comm, ierr ) + cnorm = buf2(1) rnorm0 = sqrt(slapy2(real (cnorm),aimag(cnorm))) else if (bmat .eq. 'I') then rnorm0 = pscnorm2( comm, n, resid, 1) @@ -393,8 +394,9 @@ c if (bmat .eq. 'G') then cnorm_buf = cdotc (n, resid, 1, workd, 1) - call MPI_ALLREDUCE( cnorm_buf, cnorm, 1, + call MPI_ALLREDUCE( [cnorm_buf], buf2, 1, & MPI_COMPLEX, MPI_SUM, comm, ierr ) + cnorm = buf2(1) rnorm = sqrt(slapy2(real (cnorm),aimag(cnorm))) else if (bmat .eq. 'I') then rnorm = pscnorm2(comm, n, resid, 1) @@ -405,9 +407,9 @@ c %--------------------------------------% c if (msglvl .gt. 2) then - call psvout (comm, logfil, 1, rnorm0, ndigit, + call psvout (comm, logfil, 1, [rnorm0], ndigit, & '_getv0: re-orthonalization ; rnorm0 is') - call psvout (comm, logfil, 1, rnorm, ndigit, + call psvout (comm, logfil, 1, [rnorm], ndigit, & '_getv0: re-orthonalization ; rnorm is') end if c @@ -439,7 +441,7 @@ c if (msglvl .gt. 0) then cnorm2 = cmplx(rnorm,rzero) - call pcvout (comm, logfil, 1, cnorm2, ndigit, + call pcvout (comm, logfil, 1, [cnorm2], ndigit, & '_getv0: B-norm of initial / restarted starting vector') end if if (msglvl .gt. 2) then diff -Nru arpack-3.7.0/PARPACK/SRC/MPI/pcnaitr.f arpack-3.8.0/PARPACK/SRC/MPI/pcnaitr.f --- arpack-3.7.0/PARPACK/SRC/MPI/pcnaitr.f 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/PARPACK/SRC/MPI/pcnaitr.f 2020-12-07 10:40:45.000000000 +0000 @@ -293,7 +293,7 @@ & betaj, rnorm1, smlnum, ulp, unfl, wnorm c Complex - & cnorm_buf + & cnorm_buf, buf2(1) c c %----------------------% c | External Subroutines | @@ -404,9 +404,9 @@ 1000 continue c if (msglvl .gt. 1) then - call pivout (comm, logfil, 1, j, ndigit, + call pivout (comm, logfil, 1, [j], ndigit, & '_naitr: generating Arnoldi vector number') - call pcvout (comm, logfil, 1, rnorm, ndigit, + call pdvout (comm, logfil, 1, [rnorm], ndigit, & '_naitr: B-norm of the current residual is') end if c @@ -426,7 +426,7 @@ c %---------------------------------------------------% c if (msglvl .gt. 0) then - call pivout (comm, logfil, 1, j, ndigit, + call pivout (comm, logfil, 1, [j], ndigit, & '_naitr: ****** RESTART AT STEP ******') end if c @@ -577,8 +577,9 @@ c if (bmat .eq. 'G') then cnorm_buf = cdotc (n, resid, 1, workd(ipj), 1) - call MPI_ALLREDUCE( cnorm_buf, cnorm, 1, + call MPI_ALLREDUCE( [cnorm_buf], buf2, 1, & MPI_COMPLEX, MPI_SUM, comm, ierr ) + cnorm = buf2(1) wnorm = sqrt( slapy2(real(cnorm),aimag(cnorm)) ) else if (bmat .eq. 'I') then wnorm = pscnorm2(comm, n, resid, 1) @@ -653,8 +654,9 @@ c if (bmat .eq. 'G') then cnorm_buf = cdotc (n, resid, 1, workd(ipj), 1) - call MPI_ALLREDUCE( cnorm_buf, cnorm, 1, + call MPI_ALLREDUCE( [cnorm_buf], buf2, 1, & MPI_COMPLEX, MPI_SUM, comm, ierr ) + cnorm = buf2(1) rnorm = sqrt( slapy2(real(cnorm),aimag(cnorm)) ) else if (bmat .eq. 'I') then rnorm = pscnorm2(comm, n, resid, 1) @@ -757,15 +759,16 @@ c if (bmat .eq. 'G') then cnorm_buf = cdotc (n, resid, 1, workd(ipj), 1) - call MPI_ALLREDUCE( cnorm_buf, cnorm, 1, + call MPI_ALLREDUCE( [cnorm_buf], buf2, 1, & MPI_COMPLEX, MPI_SUM, comm, ierr ) + cnorm = buf2(1) rnorm1 = sqrt( slapy2(real(cnorm),aimag(cnorm)) ) else if (bmat .eq. 'I') then rnorm1 = pscnorm2(comm, n, resid, 1) end if c if (msglvl .gt. 0 .and. iter .gt. 0 ) then - call pivout (comm, logfil, 1, j, ndigit, + call pivout (comm, logfil, 1, [j], ndigit, & '_naitr: Iterative refinement for Arnoldi residual') if (msglvl .gt. 2) then rtemp(1) = rnorm diff -Nru arpack-3.7.0/PARPACK/SRC/MPI/pcnapps.f arpack-3.8.0/PARPACK/SRC/MPI/pcnapps.f --- arpack-3.7.0/PARPACK/SRC/MPI/pcnapps.f 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/PARPACK/SRC/MPI/pcnapps.f 2020-12-07 10:40:45.000000000 +0000 @@ -283,9 +283,9 @@ sigma = shift(jj) c if (msglvl .gt. 2 ) then - call pivout (comm, logfil, 1, jj, ndigit, + call pivout (comm, logfil, 1, [jj], ndigit, & '_napps: shift number.') - call pcvout (comm, logfil, 1, sigma, ndigit, + call pcvout (comm, logfil, 1, [sigma], ndigit, & '_napps: Value of the shift ') end if c @@ -306,9 +306,9 @@ if ( abs(real(h(i+1,i))) & .le. max(ulp*tst1, smlnum) ) then if (msglvl .gt. 0) then - call pivout (comm, logfil, 1, i, ndigit, + call pivout (comm, logfil, 1, [i], ndigit, & '_napps: matrix splitting at row/column no.') - call pivout (comm, logfil, 1, jj, ndigit, + call pivout (comm, logfil, 1, [jj], ndigit, & '_napps: matrix splitting with shift number.') call pcvout (comm, logfil, 1, h(i+1,i), ndigit, & '_napps: off diagonal element.') @@ -322,9 +322,9 @@ 40 continue c if (msglvl .gt. 2) then - call pivout (comm, logfil, 1, istart, ndigit, + call pivout (comm, logfil, 1, [istart], ndigit, & '_napps: Start of current block ') - call pivout (comm, logfil, 1, iend, ndigit, + call pivout (comm, logfil, 1, [iend], ndigit, & '_napps: End of current block ') end if c @@ -500,7 +500,7 @@ & '_napps: sigmak = (e_{kev+p}^T*Q)*e_{kev}') call pcvout (comm, logfil, 1, h(kev+1,kev), ndigit, & '_napps: betak = e_{kev+1}^T*H*e_{kev}') - call pivout (comm, logfil, 1, kev, ndigit, + call pivout (comm, logfil, 1, [kev], ndigit, & '_napps: Order of the final Hessenberg matrix ') if (msglvl .gt. 2) then call pcmout (comm, logfil, kev, kev, h, ldh, ndigit, diff -Nru arpack-3.7.0/PARPACK/SRC/MPI/pcnaup2.f arpack-3.8.0/PARPACK/SRC/MPI/pcnaup2.f --- arpack-3.7.0/PARPACK/SRC/MPI/pcnaup2.f 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/PARPACK/SRC/MPI/pcnaup2.f 2020-12-07 10:40:45.000000000 +0000 @@ -237,7 +237,7 @@ & nevbef, nev0 , np0, eps23 c Real - & cmpnorm_buf + & cmpnorm_buf, buf2(1) c c %-----------------------% c | Local array arguments | @@ -401,7 +401,7 @@ iter = iter + 1 c if (msglvl .gt. 0) then - call pivout (comm, logfil, 1, iter, ndigit, + call pivout (comm, logfil, 1, [iter], ndigit, & '_naup2: **** Start of major iteration number ****') end if c @@ -414,9 +414,9 @@ np = kplusp - nev c if (msglvl .gt. 1) then - call pivout (comm, logfil, 1, nev, ndigit, + call pivout (comm, logfil, 1, [nev], ndigit, & '_naup2: The length of the current Arnoldi factorization') - call pivout (comm, logfil, 1, np, ndigit, + call pivout (comm, logfil, 1, [np], ndigit, & '_naup2: Extend the Arnoldi factorization by') end if c @@ -443,7 +443,7 @@ update = .false. c if (msglvl .gt. 1) then - call psvout (comm, logfil, 1, rnorm, ndigit, + call psvout (comm, logfil, 1, [rnorm], ndigit, & '_naup2: Corresponding B-norm of the residual') end if c @@ -674,7 +674,7 @@ end if c if (msglvl .gt. 0) then - call pivout (comm, logfil, 1, nconv, ndigit, + call pivout (comm, logfil, 1, [nconv], ndigit, & '_naup2: no. of "converged" Ritz values at this iter.') if (msglvl .gt. 1) then kp(1) = nev @@ -714,7 +714,7 @@ end if c if (msglvl .gt. 2) then - call pivout (comm, logfil, 1, np, ndigit, + call pivout (comm, logfil, 1, [np], ndigit, & '_naup2: The number of shifts to apply ') call pcvout (comm, logfil, np, ritz, ndigit, & '_naup2: values of the shifts') @@ -771,8 +771,9 @@ c if (bmat .eq. 'G') then cmpnorm_buf = cdotc (n, resid, 1, workd, 1) - call MPI_ALLREDUCE( cmpnorm_buf, cmpnorm, 1, + call MPI_ALLREDUCE( [cmpnorm_buf], buf2, 1, & MPI_COMPLEX, MPI_SUM, comm, ierr ) + cmpnorm = buf2(1) rnorm = sqrt(slapy2(real(cmpnorm),aimag(cmpnorm))) else if (bmat .eq. 'I') then rnorm = pscnorm2(comm, n, resid, 1) @@ -780,7 +781,7 @@ cnorm = .false. c if (msglvl .gt. 2) then - call psvout (comm, logfil, 1, rnorm, ndigit, + call psvout (comm, logfil, 1, [rnorm], ndigit, & '_naup2: B-norm of residual for compressed factorization') call pcmout (comm, logfil, nev, nev, h, ldh, ndigit, & '_naup2: Compressed upper Hessenberg matrix H') diff -Nru arpack-3.7.0/PARPACK/SRC/MPI/pcnaupd.f arpack-3.8.0/PARPACK/SRC/MPI/pcnaupd.f --- arpack-3.7.0/PARPACK/SRC/MPI/pcnaupd.f 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/PARPACK/SRC/MPI/pcnaupd.f 2020-12-07 10:40:45.000000000 +0000 @@ -626,9 +626,9 @@ if (info .eq. 2) info = 3 c if (msglvl .gt. 0) then - call pivout (comm, logfil, 1, mxiter, ndigit, + call pivout (comm, logfil, 1, [mxiter], ndigit, & '_naupd: Number of update iterations taken') - call pivout (comm, logfil, 1, np, ndigit, + call pivout (comm, logfil, 1, [np], ndigit, & '_naupd: Number of wanted "converged" Ritz values') call pcvout (comm, logfil, np, workl(ritz), ndigit, & '_naupd: The final Ritz values') diff -Nru arpack-3.7.0/PARPACK/SRC/MPI/pcneupd.f arpack-3.8.0/PARPACK/SRC/MPI/pcneupd.f --- arpack-3.7.0/PARPACK/SRC/MPI/pcneupd.f 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/PARPACK/SRC/MPI/pcneupd.f 2020-12-07 10:40:45.000000000 +0000 @@ -558,9 +558,9 @@ c %-----------------------------------------------------------% c if (msglvl .gt. 2) then - call pivout(comm, logfil, 1, numcnv, ndigit, + call pivout(comm, logfil, 1, [numcnv], ndigit, & '_neupd: Number of specified eigenvalues') - call pivout(comm, logfil, 1, nconv, ndigit, + call pivout(comm, logfil, 1, [nconv], ndigit, & '_neupd: Number of "converged" eigenvalues') end if c diff -Nru arpack-3.7.0/PARPACK/SRC/MPI/pcngets.f arpack-3.8.0/PARPACK/SRC/MPI/pcngets.f --- arpack-3.7.0/PARPACK/SRC/MPI/pcngets.f 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/PARPACK/SRC/MPI/pcngets.f 2020-12-07 10:40:45.000000000 +0000 @@ -177,8 +177,8 @@ tcgets = tcgets + (t1 - t0) c if (msglvl .gt. 0) then - call pivout (comm, logfil, 1, kev, ndigit, '_ngets: KEV is') - call pivout (comm, logfil, 1, np, ndigit, '_ngets: NP is') + call pivout (comm, logfil, 1, [kev], ndigit, '_ngets: KEV is') + call pivout (comm, logfil, 1, [np], ndigit, '_ngets: NP is') call pcvout (comm, logfil, kev+np, ritz, ndigit, & '_ngets: Eigenvalues of current H matrix ') call pcvout (comm, logfil, kev+np, bounds, ndigit, diff -Nru arpack-3.7.0/PARPACK/SRC/MPI/pdgetv0.f arpack-3.8.0/PARPACK/SRC/MPI/pdgetv0.f --- arpack-3.7.0/PARPACK/SRC/MPI/pdgetv0.f 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/PARPACK/SRC/MPI/pdgetv0.f 2020-12-07 10:40:45.000000000 +0000 @@ -180,7 +180,7 @@ logical first, inits, orth integer idist, iseed(4), iter, msglvl, jj Double precision - & rnorm0 + & rnorm0, buf2(1) save first, iseed, inits, iter, msglvl, orth, rnorm0 c Double precision @@ -318,9 +318,9 @@ first = .FALSE. if (bmat .eq. 'G') then rnorm_buf = ddot (n, resid, 1, workd, 1) - call MPI_ALLREDUCE( rnorm_buf, rnorm0, 1, + call MPI_ALLREDUCE( [rnorm_buf], buf2, 1, & MPI_DOUBLE_PRECISION, MPI_SUM, comm, ierr ) - rnorm0 = sqrt(abs(rnorm0)) + rnorm0 = sqrt(abs(buf2(1))) else if (bmat .eq. 'I') then rnorm0 = pdnorm2( comm, n, resid, 1 ) end if @@ -379,9 +379,9 @@ c if (bmat .eq. 'G') then rnorm_buf = ddot (n, resid, 1, workd, 1) - call MPI_ALLREDUCE( rnorm_buf, rnorm, 1, + call MPI_ALLREDUCE( [rnorm_buf], buf2, 1, & MPI_DOUBLE_PRECISION, MPI_SUM, comm, ierr ) - rnorm = sqrt(abs(rnorm)) + rnorm = sqrt(abs(buf2(1))) else if (bmat .eq. 'I') then rnorm = pdnorm2( comm, n, resid, 1 ) end if @@ -391,9 +391,9 @@ c %--------------------------------------% c if (msglvl .gt. 2) then - call pdvout (comm, logfil, 1, rnorm0, ndigit, + call pdvout (comm, logfil, 1, [rnorm0], ndigit, & '_getv0: re-orthonalization ; rnorm0 is') - call pdvout (comm, logfil, 1, rnorm, ndigit, + call pdvout (comm, logfil, 1, [rnorm], ndigit, & '_getv0: re-orthonalization ; rnorm is') end if c @@ -424,7 +424,7 @@ 50 continue c if (msglvl .gt. 0) then - call pdvout (comm, logfil, 1, rnorm, ndigit, + call pdvout (comm, logfil, 1, [rnorm], ndigit, & '_getv0: B-norm of initial / restarted starting vector') end if if (msglvl .gt. 2) then diff -Nru arpack-3.7.0/PARPACK/SRC/MPI/pdlamch10.f arpack-3.8.0/PARPACK/SRC/MPI/pdlamch10.f --- arpack-3.7.0/PARPACK/SRC/MPI/pdlamch10.f 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/PARPACK/SRC/MPI/pdlamch10.f 2020-12-07 10:40:45.000000000 +0000 @@ -57,7 +57,7 @@ * * .. Local Scalars .. INTEGER IDUMM - DOUBLE PRECISION TEMP, TEMP1 + DOUBLE PRECISION TEMP, TEMP1, buf2(1) * .. * .. External Subroutines .. * EXTERNAL DGAMN2D, DGAMX2D @@ -73,19 +73,20 @@ * IF( LSAME( CMACH, 'E' ).OR.LSAME( CMACH, 'S' ).OR. $ LSAME( CMACH, 'M' ).OR.LSAME( CMACH, 'U' ) ) THEN - CALL MPI_ALLREDUCE( TEMP1, TEMP, 1, MPI_DOUBLE_PRECISION, + CALL MPI_ALLREDUCE( [TEMP1], buf2, 1, MPI_DOUBLE_PRECISION, $ MPI_MAX, ICTXT, IDUMM ) -* CALL DGAMX2D( ICTXT, 'All', ' ', 1, 1, TEMP, 1, IDUMM, +* CALL DGAMX2D( ICTXT, 'All', ' ', 1, 1, buf2(1), 1, IDUMM, * $ IDUMM, 1, -1, IDUMM ) ELSE IF( LSAME( CMACH, 'L' ).OR.LSAME( CMACH, 'O' ) ) THEN - CALL MPI_ALLREDUCE( TEMP1, TEMP, 1, MPI_DOUBLE_PRECISION, + CALL MPI_ALLREDUCE( [TEMP1], buf2, 1, MPI_DOUBLE_PRECISION, $ MPI_MIN, ICTXT, IDUMM ) -* CALL DGAMN2D( ICTXT, 'All', ' ', 1, 1, TEMP, 1, IDUMM, +* CALL DGAMN2D( ICTXT, 'All', ' ', 1, 1, buf2(1), 1, IDUMM, * $ IDUMM, 1, -1, IDUMM ) ELSE - TEMP = TEMP1 + buf2(1) = TEMP1 END IF * + TEMP = buf2(1) PDLAMCH10 = TEMP * * End of PDLAMCH10 diff -Nru arpack-3.7.0/PARPACK/SRC/MPI/pdnaitr.f arpack-3.8.0/PARPACK/SRC/MPI/pdnaitr.f --- arpack-3.7.0/PARPACK/SRC/MPI/pdnaitr.f 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/PARPACK/SRC/MPI/pdnaitr.f 2020-12-07 10:40:45.000000000 +0000 @@ -276,7 +276,7 @@ & betaj, rnorm1, smlnum, ulp, unfl, wnorm c Double precision - & rnorm_buf + & rnorm_buf, buf2(1) c c c %-----------------------% @@ -393,9 +393,9 @@ 1000 continue c if (msglvl .gt. 1) then - call pivout (comm, logfil, 1, j, ndigit, + call pivout (comm, logfil, 1, [j], ndigit, & '_naitr: generating Arnoldi vector number') - call pdvout (comm, logfil, 1, rnorm, ndigit, + call pdvout (comm, logfil, 1, [rnorm], ndigit, & '_naitr: B-norm of the current residual is') end if c @@ -415,7 +415,7 @@ c %---------------------------------------------------% c if (msglvl .gt. 0) then - call pivout (comm, logfil, 1, j, ndigit, + call pivout (comm, logfil, 1, [j], ndigit, & '_naitr: ****** RESTART AT STEP ******') end if c @@ -566,9 +566,9 @@ c if (bmat .eq. 'G') then rnorm_buf = ddot (n, resid, 1, workd(ipj), 1) - call MPI_ALLREDUCE( rnorm_buf, wnorm, 1, + call MPI_ALLREDUCE( [rnorm_buf], buf2, 1, & MPI_DOUBLE_PRECISION, MPI_SUM, comm, ierr ) - wnorm = sqrt(abs(wnorm)) + wnorm = sqrt(abs(buf2(1))) else if (bmat .eq. 'I') then wnorm = pdnorm2( comm, n, resid, 1 ) end if @@ -642,9 +642,9 @@ c if (bmat .eq. 'G') then rnorm_buf = ddot (n, resid, 1, workd(ipj), 1) - call MPI_ALLREDUCE( rnorm_buf, rnorm, 1, + call MPI_ALLREDUCE( [rnorm_buf], buf2, 1, & MPI_DOUBLE_PRECISION, MPI_SUM, comm, ierr ) - rnorm = sqrt(abs(rnorm)) + rnorm = sqrt(abs(buf2(1))) else if (bmat .eq. 'I') then rnorm = pdnorm2( comm, n, resid, 1 ) end if @@ -745,15 +745,15 @@ c if (bmat .eq. 'G') then rnorm_buf = ddot (n, resid, 1, workd(ipj), 1) - call MPI_ALLREDUCE( rnorm_buf, rnorm1, 1, + call MPI_ALLREDUCE( [rnorm_buf], buf2, 1, & MPI_DOUBLE_PRECISION, MPI_SUM, comm, ierr ) - rnorm1 = sqrt(abs(rnorm1)) + rnorm1 = sqrt(abs(buf2(1))) else if (bmat .eq. 'I') then rnorm1 = pdnorm2( comm, n, resid, 1 ) end if c if (msglvl .gt. 0 .and. iter .gt. 0) then - call pivout (comm, logfil, 1, j, ndigit, + call pivout (comm, logfil, 1, [j], ndigit, & '_naitr: Iterative refinement for Arnoldi residual') if (msglvl .gt. 2) then xtemp(1) = rnorm diff -Nru arpack-3.7.0/PARPACK/SRC/MPI/pdnapps.f arpack-3.8.0/PARPACK/SRC/MPI/pdnapps.f --- arpack-3.7.0/PARPACK/SRC/MPI/pdnapps.f 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/PARPACK/SRC/MPI/pdnapps.f 2020-12-07 10:40:45.000000000 +0000 @@ -276,11 +276,11 @@ sigmai = shifti(jj) c if (msglvl .gt. 2 ) then - call pivout (comm, logfil, 1, jj, ndigit, + call pivout (comm, logfil, 1, [jj], ndigit, & '_napps: shift number.') - call pdvout (comm, logfil, 1, sigmar, ndigit, + call pdvout (comm, logfil, 1, [sigmar], ndigit, & '_napps: The real part of the shift ') - call pdvout (comm, logfil, 1, sigmai, ndigit, + call pdvout (comm, logfil, 1, [sigmai], ndigit, & '_napps: The imaginary part of the shift ') end if c @@ -345,9 +345,9 @@ & tst1 = dlanhs( '1', kplusp-jj+1, h, ldh, workl ) if( abs( h( i+1,i ) ).le.max( ulp*tst1, smlnum ) ) then if (msglvl .gt. 0) then - call pivout (comm, logfil, 1, i, ndigit, + call pivout (comm, logfil, 1, [i], ndigit, & '_napps: matrix splitting at row/column no.') - call pivout (comm, logfil, 1, jj, ndigit, + call pivout (comm, logfil, 1, [jj], ndigit, & '_napps: matrix splitting with shift number.') call pdvout (comm, logfil, 1, h(i+1,i), ndigit, & '_napps: off diagonal element.') @@ -361,9 +361,9 @@ 40 continue c if (msglvl .gt. 2) then - call pivout (comm, logfil, 1, istart, ndigit, + call pivout (comm, logfil, 1, [istart], ndigit, & '_napps: Start of current block ') - call pivout (comm, logfil, 1, iend, ndigit, + call pivout (comm, logfil, 1, [iend], ndigit, & '_napps: End of current block ') end if c @@ -635,7 +635,7 @@ & '_napps: sigmak = (e_{kev+p}^T*Q)*e_{kev}') call pdvout (comm, logfil, 1, h(kev+1,kev), ndigit, & '_napps: betak = e_{kev+1}^T*H*e_{kev}') - call pivout (comm, logfil, 1, kev, ndigit, + call pivout (comm, logfil, 1, [kev], ndigit, & '_napps: Order of the final Hessenberg matrix ') if (msglvl .gt. 2) then call pdmout (comm, logfil, kev, kev, h, ldh, ndigit, diff -Nru arpack-3.7.0/PARPACK/SRC/MPI/pdnaup2.f arpack-3.8.0/PARPACK/SRC/MPI/pdnaup2.f --- arpack-3.7.0/PARPACK/SRC/MPI/pdnaup2.f 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/PARPACK/SRC/MPI/pdnaup2.f 2020-12-07 10:40:45.000000000 +0000 @@ -234,7 +234,7 @@ & nevbef, nev0 , np0 , nptemp, numcnv, & j Double precision - & rnorm , temp , eps23 + & rnorm , temp , eps23, buf2(1) save cnorm , getv0, initv , update, ushift, & rnorm , iter , kplusp, msglvl, nconv, & nevbef, nev0 , np0 , eps23 , numcnv @@ -408,7 +408,7 @@ iter = iter + 1 c if (msglvl .gt. 0) then - call pivout (comm, logfil, 1, iter, ndigit, + call pivout (comm, logfil, 1, [iter], ndigit, & '_naup2: **** Start of major iteration number ****') end if c @@ -421,9 +421,9 @@ np = kplusp - nev c if (msglvl .gt. 1) then - call pivout (comm, logfil, 1, nev, ndigit, + call pivout (comm, logfil, 1, [nev], ndigit, & '_naup2: The length of the current Arnoldi factorization') - call pivout (comm, logfil, 1, np, ndigit, + call pivout (comm, logfil, 1, [np], ndigit, & '_naup2: Extend the Arnoldi factorization by') end if c @@ -455,7 +455,7 @@ update = .false. c if (msglvl .gt. 1) then - call pdvout (comm, logfil, 1, rnorm, ndigit, + call pdvout (comm, logfil, 1, [rnorm], ndigit, & '_naup2: Corresponding B-norm of the residual') end if c @@ -699,7 +699,7 @@ end if c if (msglvl .gt. 0) then - call pivout (comm, logfil, 1, nconv, ndigit, + call pivout (comm, logfil, 1, [nconv], ndigit, & '_naup2: no. of "converged" Ritz values at this iter.') if (msglvl .gt. 1) then kp(1) = nev @@ -751,7 +751,7 @@ end if c if (msglvl .gt. 2) then - call pivout (comm, logfil, 1, np, ndigit, + call pivout (comm, logfil, 1, [np], ndigit, & '_naup2: The number of shifts to apply ') call pdvout (comm, logfil, np, ritzr, ndigit, & '_naup2: Real part of the shifts') @@ -810,16 +810,16 @@ c if (bmat .eq. 'G') then rnorm_buf = ddot (n, resid, 1, workd, 1) - call MPI_ALLREDUCE( rnorm_buf, rnorm, 1, + call MPI_ALLREDUCE( [rnorm_buf], buf2, 1, & MPI_DOUBLE_PRECISION , MPI_SUM, comm, ierr ) - rnorm = sqrt(abs(rnorm)) + rnorm = sqrt(abs(buf2(1))) else if (bmat .eq. 'I') then rnorm = pdnorm2 ( comm, n, resid, 1 ) end if cnorm = .false. c if (msglvl .gt. 2) then - call pdvout (comm, logfil, 1, rnorm, ndigit, + call pdvout (comm, logfil, 1, [rnorm], ndigit, & '_naup2: B-norm of residual for compressed factorization') call pdmout (comm, logfil, nev, nev, h, ldh, ndigit, & '_naup2: Compressed upper Hessenberg matrix H') diff -Nru arpack-3.7.0/PARPACK/SRC/MPI/pdnaupd.f arpack-3.8.0/PARPACK/SRC/MPI/pdnaupd.f --- arpack-3.7.0/PARPACK/SRC/MPI/pdnaupd.f 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/PARPACK/SRC/MPI/pdnaupd.f 2020-12-07 10:40:45.000000000 +0000 @@ -650,9 +650,9 @@ if (info .eq. 2) info = 3 c if (msglvl .gt. 0) then - call pivout (comm, logfil, 1, mxiter, ndigit, + call pivout (comm, logfil, 1, [mxiter], ndigit, & '_naupd: Number of update iterations taken') - call pivout (comm, logfil, 1, np, ndigit, + call pivout (comm, logfil, 1, [np], ndigit, & '_naupd: Number of wanted "converged" Ritz values') call pdvout (comm, logfil, np, workl(ritzr), ndigit, & '_naupd: Real part of the final Ritz values') diff -Nru arpack-3.7.0/PARPACK/SRC/MPI/pdneupd.f arpack-3.8.0/PARPACK/SRC/MPI/pdneupd.f --- arpack-3.7.0/PARPACK/SRC/MPI/pdneupd.f 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/PARPACK/SRC/MPI/pdneupd.f 2020-12-07 10:40:45.000000000 +0000 @@ -617,9 +617,9 @@ c %-----------------------------------------------------------% c if (msglvl .gt. 2) then - call pivout(comm, logfil, 1, numcnv, ndigit, + call pivout(comm, logfil, 1, [numcnv], ndigit, & '_neupd: Number of specified eigenvalues') - call pivout(comm, logfil, 1, nconv, ndigit, + call pivout(comm, logfil, 1, [nconv], ndigit, & '_neupd: Number of "converged" eigenvalues') end if c diff -Nru arpack-3.7.0/PARPACK/SRC/MPI/pdngets.f arpack-3.8.0/PARPACK/SRC/MPI/pdngets.f --- arpack-3.7.0/PARPACK/SRC/MPI/pdngets.f 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/PARPACK/SRC/MPI/pdngets.f 2020-12-07 10:40:45.000000000 +0000 @@ -226,8 +226,8 @@ tngets = tngets + (t1 - t0) c if (msglvl .gt. 0) then - call pivout (comm, logfil, 1, kev, ndigit, '_ngets: KEV is') - call pivout (comm, logfil, 1, np, ndigit, '_ngets: NP is') + call pivout (comm, logfil, 1, [kev], ndigit, '_ngets: KEV is') + call pivout (comm, logfil, 1, [np], ndigit, '_ngets: NP is') call pdvout (comm, logfil, kev+np, ritzr, ndigit, & '_ngets: Eigenvalues of current H matrix -- real part') call pdvout (comm, logfil, kev+np, ritzi, ndigit, diff -Nru arpack-3.7.0/PARPACK/SRC/MPI/pdnorm2.f arpack-3.8.0/PARPACK/SRC/MPI/pdnorm2.f --- arpack-3.7.0/PARPACK/SRC/MPI/pdnorm2.f 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/PARPACK/SRC/MPI/pdnorm2.f 2020-12-07 10:40:45.000000000 +0000 @@ -45,7 +45,7 @@ c %---------------% c Double precision - & max, buf, zero + & max, buf, zero, buf2(1) parameter ( zero = 0.0 ) c c %---------------------% @@ -69,15 +69,16 @@ pdnorm2 = dnrm2( n, x, inc) c buf = pdnorm2 - call MPI_ALLREDUCE( buf, max, 1, MPI_DOUBLE_PRECISION, + call MPI_ALLREDUCE( [buf], buf2, 1, MPI_DOUBLE_PRECISION, & MPI_MAX, comm, ierr ) + max = buf2(1) if ( max .eq. zero ) then pdnorm2 = zero else buf = (pdnorm2/max)**2.0 - call MPI_ALLREDUCE( buf, pdnorm2, 1, MPI_DOUBLE_PRECISION, + call MPI_ALLREDUCE( [buf], buf2, 1, MPI_DOUBLE_PRECISION, & MPI_SUM, comm, ierr ) - pdnorm2 = max * sqrt(abs(pdnorm2)) + pdnorm2 = max * sqrt(abs(buf2(1))) endif c c %----------------% diff -Nru arpack-3.7.0/PARPACK/SRC/MPI/pdsaitr.f arpack-3.8.0/PARPACK/SRC/MPI/pdsaitr.f --- arpack-3.7.0/PARPACK/SRC/MPI/pdsaitr.f 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/PARPACK/SRC/MPI/pdsaitr.f 2020-12-07 10:40:45.000000000 +0000 @@ -264,7 +264,7 @@ integer i, ierr, ipj, irj, ivj, iter, itry, j, msglvl, infol, & jj Double precision - & rnorm1, wnorm, safmin, temp1 + & rnorm1, wnorm, safmin, temp1, buf2(1) save orth1, orth2, rstart, step3, step4, & ierr, ipj, irj, ivj, iter, itry, j, msglvl, & rnorm1, safmin, wnorm @@ -392,9 +392,9 @@ 1000 continue c if (msglvl .gt. 2) then - call pivout (comm, logfil, 1, j, ndigit, + call pivout (comm, logfil, 1, [j], ndigit, & '_saitr: generating Arnoldi vector no.') - call pdvout (comm, logfil, 1, rnorm, ndigit, + call pdvout (comm, logfil, 1, [rnorm], ndigit, & '_saitr: B-norm of the current residual =') end if c @@ -412,7 +412,7 @@ c %---------------------------------------------------% c if (msglvl .gt. 0) then - call pivout (comm, logfil, 1, j, ndigit, + call pivout (comm, logfil, 1, [j], ndigit, & '_saitr: ****** restart at step ******') end if c @@ -572,14 +572,14 @@ c %----------------------------------% c rnorm_buf = ddot (n, resid, 1, workd(ivj), 1) - call MPI_ALLREDUCE( rnorm_buf, wnorm, 1, + call MPI_ALLREDUCE( [rnorm_buf], buf2, 1, & MPI_DOUBLE_PRECISION, MPI_SUM, comm, ierr ) - wnorm = sqrt(abs(wnorm)) + wnorm = sqrt(abs(buf2(1))) else if (bmat .eq. 'G') then rnorm_buf = ddot (n, resid, 1, workd(ipj), 1) - call MPI_ALLREDUCE( rnorm_buf, wnorm, 1, + call MPI_ALLREDUCE( [rnorm_buf], buf2, 1, & MPI_DOUBLE_PRECISION, MPI_SUM, comm, ierr ) - wnorm = sqrt(abs(wnorm)) + wnorm = sqrt(abs(buf2(1))) else if (bmat .eq. 'I') then wnorm = pdnorm2( comm, n, resid, 1 ) end if @@ -669,9 +669,9 @@ c if (bmat .eq. 'G') then rnorm_buf = ddot (n, resid, 1, workd(ipj), 1) - call MPI_ALLREDUCE( rnorm_buf, rnorm, 1, + call MPI_ALLREDUCE( [rnorm_buf], buf2, 1, & MPI_DOUBLE_PRECISION, MPI_SUM, comm, ierr ) - rnorm = sqrt(abs(rnorm)) + rnorm = sqrt(abs(buf2(1))) else if (bmat .eq. 'I') then rnorm = pdnorm2( comm, n, resid, 1 ) end if @@ -769,15 +769,15 @@ c if (bmat .eq. 'G') then rnorm_buf = ddot (n, resid, 1, workd(ipj), 1) - call MPI_ALLREDUCE( rnorm_buf, rnorm1, 1, + call MPI_ALLREDUCE( [rnorm_buf], buf2(1), 1, & MPI_DOUBLE_PRECISION, MPI_SUM, comm, ierr ) - rnorm1 = sqrt(abs(rnorm1)) + rnorm1 = sqrt(abs(buf2(1))) else if (bmat .eq. 'I') then rnorm1 = pdnorm2( comm, n, resid, 1 ) end if c if (msglvl .gt. 0 .and. iter .gt. 0) then - call pivout (comm, logfil, 1, j, ndigit, + call pivout (comm, logfil, 1, [j], ndigit, & '_naitr: Iterative refinement for Arnoldi residual') if (msglvl .gt. 2) then xtemp(1) = rnorm diff -Nru arpack-3.7.0/PARPACK/SRC/MPI/pdsapps.f arpack-3.8.0/PARPACK/SRC/MPI/pdsapps.f --- arpack-3.7.0/PARPACK/SRC/MPI/pdsapps.f 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/PARPACK/SRC/MPI/pdsapps.f 2020-12-07 10:40:45.000000000 +0000 @@ -272,9 +272,9 @@ big = abs(h(i,2)) + abs(h(i+1,2)) if (h(i+1,1) .le. epsmch*big) then if (msglvl .gt. 0) then - call pivout (comm, logfil, 1, i, ndigit, + call pivout (comm, logfil, 1, [i], ndigit, & '_sapps: deflation at row/column no.') - call pivout (comm, logfil, 1, jj, ndigit, + call pivout (comm, logfil, 1, [jj], ndigit, & '_sapps: occurred before shift number.') call pdvout (comm, logfil, 1, h(i+1,1), ndigit, & '_sapps: the corresponding off diagonal element') @@ -443,7 +443,7 @@ big = abs(h(i,2)) + abs(h(i+1,2)) if (h(i+1,1) .le. epsmch*big) then if (msglvl .gt. 0) then - call pivout (comm, logfil, 1, i, ndigit, + call pivout (comm, logfil, 1, [i], ndigit, & '_sapps: deflation at row/column no.') call pdvout (comm, logfil, 1, h(i+1,1), ndigit, & '_sapps: the corresponding off diagonal element') diff -Nru arpack-3.7.0/PARPACK/SRC/MPI/pdsaup2.f arpack-3.8.0/PARPACK/SRC/MPI/pdsaup2.f --- arpack-3.7.0/PARPACK/SRC/MPI/pdsaup2.f 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/PARPACK/SRC/MPI/pdsaup2.f 2020-12-07 10:40:45.000000000 +0000 @@ -212,7 +212,7 @@ integer ido, info, ishift, iupd, ldh, ldq, ldv, mxiter, & n, mode, nev, np Double precision - & tol + & tol, buf2(1) c c %-----------------% c | Array Arguments | @@ -424,13 +424,13 @@ iter = iter + 1 c if (msglvl .gt. 0) then - call pivout (comm, logfil, 1, iter, ndigit, + call pivout (comm, logfil, 1, [iter], ndigit, & '_saup2: **** Start of major iteration number ****') end if if (msglvl .gt. 1) then - call pivout (comm, logfil, 1, nev, ndigit, + call pivout (comm, logfil, 1, [nev], ndigit, & '_saup2: The length of the current Lanczos factorization') - call pivout (comm, logfil, 1, np, ndigit, + call pivout (comm, logfil, 1, [np], ndigit, & '_saup2: Extend the Lanczos factorization by') end if c @@ -469,7 +469,7 @@ update = .false. c if (msglvl .gt. 1) then - call pdvout (comm, logfil, 1, rnorm, ndigit, + call pdvout (comm, logfil, 1, [rnorm], ndigit, & '_saup2: Current B-norm of residual for factorization') end if c @@ -719,7 +719,7 @@ end if c if (msglvl .gt. 0) then - call pivout (comm, logfil, 1, nconv, ndigit, + call pivout (comm, logfil, 1, [nconv], ndigit, & '_saup2: no. of "converged" Ritz values at this iter.') if (msglvl .gt. 1) then kp(1) = nev @@ -766,7 +766,7 @@ if (ishift .eq. 0) call dcopy (np, workl, 1, ritz, 1) c if (msglvl .gt. 2) then - call pivout (comm, logfil, 1, np, ndigit, + call pivout (comm, logfil, 1, [np], ndigit, & '_saup2: The number of shifts to apply ') call pdvout (comm, logfil, np, workl, ndigit, & '_saup2: shifts selected') @@ -825,9 +825,9 @@ c if (bmat .eq. 'G') then rnorm_buf = ddot (n, resid, 1, workd, 1) - call MPI_ALLREDUCE( rnorm_buf, rnorm, 1, + call MPI_ALLREDUCE( [rnorm_buf], buf2, 1, & MPI_DOUBLE_PRECISION, MPI_SUM, comm, ierr ) - rnorm = sqrt(abs(rnorm)) + rnorm = sqrt(abs(buf2(1))) else if (bmat .eq. 'I') then rnorm = pdnorm2( comm, n, resid, 1 ) end if @@ -835,7 +835,7 @@ 130 continue c if (msglvl .gt. 2) then - call pdvout (comm, logfil, 1, rnorm, ndigit, + call pdvout (comm, logfil, 1, [rnorm], ndigit, & '_saup2: B-norm of residual for NEV factorization') call pdvout (comm, logfil, nev, h(1,2), ndigit, & '_saup2: main diagonal of compressed H matrix') diff -Nru arpack-3.7.0/PARPACK/SRC/MPI/pdsaupd.f arpack-3.8.0/PARPACK/SRC/MPI/pdsaupd.f --- arpack-3.7.0/PARPACK/SRC/MPI/pdsaupd.f 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/PARPACK/SRC/MPI/pdsaupd.f 2020-12-07 10:40:45.000000000 +0000 @@ -652,9 +652,9 @@ if (info .eq. 2) info = 3 c if (msglvl .gt. 0) then - call pivout (comm, logfil, 1, mxiter, ndigit, + call pivout (comm, logfil, 1, [mxiter], ndigit, & '_saupd: number of update iterations taken') - call pivout (comm, logfil, 1, np, ndigit, + call pivout (comm, logfil, 1, [np], ndigit, & '_saupd: number of "converged" Ritz values') call pdvout (comm, logfil, np, workl(Ritz), ndigit, & '_saupd: final Ritz values') diff -Nru arpack-3.7.0/PARPACK/SRC/MPI/pdseupd.f arpack-3.8.0/PARPACK/SRC/MPI/pdseupd.f --- arpack-3.7.0/PARPACK/SRC/MPI/pdseupd.f 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/PARPACK/SRC/MPI/pdseupd.f 2020-12-07 10:40:45.000000000 +0000 @@ -523,9 +523,9 @@ c %-----------------------------------------------------------% c if (msglvl .gt. 2) then - call pivout(comm, logfil, 1, numcnv, ndigit, + call pivout(comm, logfil, 1, [numcnv], ndigit, & '_neupd: Number of specified eigenvalues') - call pivout(comm, logfil, 1, nconv, ndigit, + call pivout(comm, logfil, 1, [nconv], ndigit, & '_neupd: Number of "converged" eigenvalues') end if c diff -Nru arpack-3.7.0/PARPACK/SRC/MPI/pdsgets.f arpack-3.8.0/PARPACK/SRC/MPI/pdsgets.f --- arpack-3.7.0/PARPACK/SRC/MPI/pdsgets.f 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/PARPACK/SRC/MPI/pdsgets.f 2020-12-07 10:40:45.000000000 +0000 @@ -216,8 +216,8 @@ tsgets = tsgets + (t1 - t0) c if (msglvl .gt. 0) then - call pivout (comm, logfil, 1, kev, ndigit, '_sgets: KEV is') - call pivout (comm, logfil, 1, np, ndigit, '_sgets: NP is') + call pivout (comm, logfil, 1, [kev], ndigit, '_sgets: KEV is') + call pivout (comm, logfil, 1, [np], ndigit, '_sgets: NP is') call pdvout (comm, logfil, kev+np, ritz, ndigit, & '_sgets: Eigenvalues of current H matrix') call pdvout (comm, logfil, kev+np, bounds, ndigit, diff -Nru arpack-3.7.0/PARPACK/SRC/MPI/pdznorm2.f arpack-3.8.0/PARPACK/SRC/MPI/pdznorm2.f --- arpack-3.7.0/PARPACK/SRC/MPI/pdznorm2.f 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/PARPACK/SRC/MPI/pdznorm2.f 2020-12-07 10:40:45.000000000 +0000 @@ -45,7 +45,7 @@ c %---------------% c Double precision - & max, buf, zero + & max(1), buf, zero parameter ( zero = 0.0 ) c c %---------------------% @@ -59,7 +59,7 @@ c %--------------------% c Double precision - & dznrm2 + & dznrm2, buf2(1) External dznrm2 c c %-----------------------% @@ -69,15 +69,15 @@ pdznorm2 = dznrm2( n, x, inc) c buf = pdznorm2 - call MPI_ALLREDUCE( buf, max, 1, MPI_DOUBLE_PRECISION, + call MPI_ALLREDUCE( [buf], max, 1, MPI_DOUBLE_PRECISION, & MPI_MAX, comm, ierr ) - if ( max .eq. zero ) then + if ( max(1) .eq. zero ) then pdznorm2 = zero else - buf = (pdznorm2/max)**2.0 - call MPI_ALLREDUCE( buf, pdznorm2, 1, MPI_DOUBLE_PRECISION, + buf = (pdznorm2/max(1))**2.0 + call MPI_ALLREDUCE( [buf], buf2, 1, MPI_DOUBLE_PRECISION, & MPI_SUM, comm, ierr ) - pdznorm2 = max * sqrt(abs(pdznorm2)) + pdznorm2 = max(1) * sqrt(abs(buf2(1))) endif c c %-----------------% diff -Nru arpack-3.7.0/PARPACK/SRC/MPI/pscnorm2.f arpack-3.8.0/PARPACK/SRC/MPI/pscnorm2.f --- arpack-3.7.0/PARPACK/SRC/MPI/pscnorm2.f 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/PARPACK/SRC/MPI/pscnorm2.f 2020-12-07 10:40:45.000000000 +0000 @@ -45,7 +45,7 @@ c %---------------% c Real - & max, buf, zero + & max(1), buf, zero parameter ( zero = 0.0 ) c c %---------------------% @@ -61,6 +61,7 @@ Real & scnrm2 External scnrm2 + Real buf2(1) c c %-----------------------% c | Executable Statements | @@ -69,15 +70,15 @@ pscnorm2 = scnrm2( n, x, inc) c buf = pscnorm2 - call MPI_ALLREDUCE( buf, max, 1, MPI_REAL, + call MPI_ALLREDUCE( [buf], max, 1, MPI_REAL, & MPI_MAX, comm, ierr ) - if ( max .eq. zero ) then + if ( max(1) .eq. zero ) then pscnorm2 = zero else - buf = (pscnorm2/max)**2.0 - call MPI_ALLREDUCE( buf, pscnorm2, 1, MPI_REAL, + buf = (pscnorm2/max(1))**2.0 + call MPI_ALLREDUCE( [buf], buf2, 1, MPI_REAL, & MPI_SUM, comm, ierr ) - pscnorm2 = max * sqrt(abs(pscnorm2)) + pscnorm2 = max(1) * sqrt(abs(buf2(1))) endif c c %-----------------% diff -Nru arpack-3.7.0/PARPACK/SRC/MPI/psgetv0.f arpack-3.8.0/PARPACK/SRC/MPI/psgetv0.f --- arpack-3.7.0/PARPACK/SRC/MPI/psgetv0.f 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/PARPACK/SRC/MPI/psgetv0.f 2020-12-07 10:40:45.000000000 +0000 @@ -163,7 +163,7 @@ c integer ipntr(3) Real - & resid(n), v(ldv,j), workd(2*n), workl(2*j) + & resid(n), v(ldv,j), workd(2*n), workl(2*j), buf2(1) c c %------------% c | Parameters | @@ -318,9 +318,9 @@ first = .FALSE. if (bmat .eq. 'G') then rnorm_buf = sdot (n, resid, 1, workd, 1) - call MPI_ALLREDUCE( rnorm_buf, rnorm0, 1, + call MPI_ALLREDUCE( [rnorm_buf], buf2, 1, & MPI_REAL, MPI_SUM, comm, ierr ) - rnorm0 = sqrt(abs(rnorm0)) + rnorm0 = sqrt(abs(buf2(1))) else if (bmat .eq. 'I') then rnorm0 = psnorm2( comm, n, resid, 1 ) end if @@ -379,9 +379,9 @@ c if (bmat .eq. 'G') then rnorm_buf = sdot (n, resid, 1, workd, 1) - call MPI_ALLREDUCE( rnorm_buf, rnorm, 1, + call MPI_ALLREDUCE( [rnorm_buf], buf2, 1, & MPI_REAL, MPI_SUM, comm, ierr ) - rnorm = sqrt(abs(rnorm)) + rnorm = sqrt(abs(buf2(1))) else if (bmat .eq. 'I') then rnorm = psnorm2( comm, n, resid, 1 ) end if @@ -391,9 +391,9 @@ c %--------------------------------------% c if (msglvl .gt. 2) then - call psvout (comm, logfil, 1, rnorm0, ndigit, + call psvout (comm, logfil, 1, [rnorm0], ndigit, & '_getv0: re-orthonalization ; rnorm0 is') - call psvout (comm, logfil, 1, rnorm, ndigit, + call psvout (comm, logfil, 1, [rnorm], ndigit, & '_getv0: re-orthonalization ; rnorm is') end if c @@ -424,7 +424,7 @@ 50 continue c if (msglvl .gt. 0) then - call psvout (comm, logfil, 1, rnorm, ndigit, + call psvout (comm, logfil, 1, [rnorm], ndigit, & '_getv0: B-norm of initial / restarted starting vector') end if if (msglvl .gt. 2) then diff -Nru arpack-3.7.0/PARPACK/SRC/MPI/pslamch10.f arpack-3.8.0/PARPACK/SRC/MPI/pslamch10.f --- arpack-3.7.0/PARPACK/SRC/MPI/pslamch10.f 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/PARPACK/SRC/MPI/pslamch10.f 2020-12-07 10:40:45.000000000 +0000 @@ -53,7 +53,7 @@ * * .. Local Scalars .. INTEGER IDUMM - REAL TEMP, TEMP1 + REAL TEMP, TEMP1, buf2(1) * .. * .. External Subroutines .. * EXTERNAL SGAMN2D, SGAMX2D @@ -69,14 +69,16 @@ * IF( LSAME( CMACH, 'E' ).OR.LSAME( CMACH, 'S' ).OR. $ LSAME( CMACH, 'M' ).OR.LSAME( CMACH, 'U' ) ) THEN - CALL MPI_ALLREDUCE( TEMP1, TEMP, 1, MPI_REAL, + CALL MPI_ALLREDUCE( [TEMP1], buf2, 1, MPI_REAL, $ MPI_MAX, ICTXT, IDUMM ) -* CALL SGAMX2D( ICTXT, 'All', ' ', 1, 1, TEMP, 1, IDUMM, + TEMP = buf2(1) +* CALL SGAMX2D( ICTXT, 'All', ' ', 1, 1, TEMP, 1, IDUMM, * $ IDUMM, 1, -1, IDUMM ) ELSE IF( LSAME( CMACH, 'L' ).OR.LSAME( CMACH, 'O' ) ) THEN - CALL MPI_ALLREDUCE( TEMP1, TEMP, 1, MPI_REAL, + CALL MPI_ALLREDUCE( [TEMP1], buf2, 1, MPI_REAL, $ MPI_MIN, ICTXT, IDUMM ) -* CALL SGAMN2D( ICTXT, 'All', ' ', 1, 1, TEMP, 1, IDUMM, + TEMP = buf2(1) +* CALL SGAMN2D( ICTXT, 'All', ' ', 1, 1, TEMP, 1, IDUMM, * $ IDUMM, 1, -1, IDUMM ) ELSE TEMP = TEMP1 diff -Nru arpack-3.7.0/PARPACK/SRC/MPI/psnaitr.f arpack-3.8.0/PARPACK/SRC/MPI/psnaitr.f --- arpack-3.7.0/PARPACK/SRC/MPI/psnaitr.f 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/PARPACK/SRC/MPI/psnaitr.f 2020-12-07 10:40:45.000000000 +0000 @@ -276,7 +276,7 @@ & betaj, rnorm1, smlnum, ulp, unfl, wnorm c Real - & rnorm_buf + & rnorm_buf, buf2(1) c c c %-----------------------% @@ -393,9 +393,9 @@ 1000 continue c if (msglvl .gt. 1) then - call pivout (comm, logfil, 1, j, ndigit, + call pivout (comm, logfil, 1, [j], ndigit, & '_naitr: generating Arnoldi vector number') - call psvout (comm, logfil, 1, rnorm, ndigit, + call psvout (comm, logfil, 1, [rnorm], ndigit, & '_naitr: B-norm of the current residual is') end if c @@ -415,7 +415,7 @@ c %---------------------------------------------------% c if (msglvl .gt. 0) then - call pivout (comm, logfil, 1, j, ndigit, + call pivout (comm, logfil, 1, [j], ndigit, & '_naitr: ****** RESTART AT STEP ******') end if c @@ -566,9 +566,9 @@ c if (bmat .eq. 'G') then rnorm_buf = sdot (n, resid, 1, workd(ipj), 1) - call MPI_ALLREDUCE( rnorm_buf, wnorm, 1, + call MPI_ALLREDUCE( [rnorm_buf], buf2, 1, & MPI_REAL, MPI_SUM, comm, ierr ) - wnorm = sqrt(abs(wnorm)) + wnorm = sqrt(abs(buf2(1))) else if (bmat .eq. 'I') then wnorm = psnorm2( comm, n, resid, 1 ) end if @@ -642,9 +642,9 @@ c if (bmat .eq. 'G') then rnorm_buf = sdot (n, resid, 1, workd(ipj), 1) - call MPI_ALLREDUCE( rnorm_buf, rnorm, 1, + call MPI_ALLREDUCE( [rnorm_buf], buf2, 1, & MPI_REAL, MPI_SUM, comm, ierr ) - rnorm = sqrt(abs(rnorm)) + rnorm = sqrt(abs(buf2(1))) else if (bmat .eq. 'I') then rnorm = psnorm2( comm, n, resid, 1 ) end if @@ -745,15 +745,15 @@ c if (bmat .eq. 'G') then rnorm_buf = sdot (n, resid, 1, workd(ipj), 1) - call MPI_ALLREDUCE( rnorm_buf, rnorm1, 1, + call MPI_ALLREDUCE( [rnorm_buf], buf2, 1, & MPI_REAL, MPI_SUM, comm, ierr ) - rnorm1 = sqrt(abs(rnorm1)) + rnorm1 = sqrt(abs(buf2(1))) else if (bmat .eq. 'I') then rnorm1 = psnorm2( comm, n, resid, 1 ) end if c if (msglvl .gt. 0 .and. iter .gt. 0) then - call pivout (comm, logfil, 1, j, ndigit, + call pivout (comm, logfil, 1, [j], ndigit, & '_naitr: Iterative refinement for Arnoldi residual') if (msglvl .gt. 2) then xtemp(1) = rnorm diff -Nru arpack-3.7.0/PARPACK/SRC/MPI/psnapps.f arpack-3.8.0/PARPACK/SRC/MPI/psnapps.f --- arpack-3.7.0/PARPACK/SRC/MPI/psnapps.f 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/PARPACK/SRC/MPI/psnapps.f 2020-12-07 10:40:45.000000000 +0000 @@ -276,11 +276,11 @@ sigmai = shifti(jj) c if (msglvl .gt. 2 ) then - call pivout (comm, logfil, 1, jj, ndigit, + call pivout (comm, logfil, 1, [jj], ndigit, & '_napps: shift number.') - call psvout (comm, logfil, 1, sigmar, ndigit, + call psvout (comm, logfil, 1, [sigmar], ndigit, & '_napps: The real part of the shift ') - call psvout (comm, logfil, 1, sigmai, ndigit, + call psvout (comm, logfil, 1, [sigmai], ndigit, & '_napps: The imaginary part of the shift ') end if c @@ -345,9 +345,9 @@ & tst1 = slanhs( '1', kplusp-jj+1, h, ldh, workl ) if( abs( h( i+1,i ) ).le.max( ulp*tst1, smlnum ) ) then if (msglvl .gt. 0) then - call pivout (comm, logfil, 1, i, ndigit, + call pivout (comm, logfil, 1, [i], ndigit, & '_napps: matrix splitting at row/column no.') - call pivout (comm, logfil, 1, jj, ndigit, + call pivout (comm, logfil, 1, [jj], ndigit, & '_napps: matrix splitting with shift number.') call psvout (comm, logfil, 1, h(i+1,i), ndigit, & '_napps: off diagonal element.') @@ -361,9 +361,9 @@ 40 continue c if (msglvl .gt. 2) then - call pivout (comm, logfil, 1, istart, ndigit, + call pivout (comm, logfil, 1, [istart], ndigit, & '_napps: Start of current block ') - call pivout (comm, logfil, 1, iend, ndigit, + call pivout (comm, logfil, 1, [iend], ndigit, & '_napps: End of current block ') end if c @@ -635,7 +635,7 @@ & '_napps: sigmak = (e_{kev+p}^T*Q)*e_{kev}') call psvout (comm, logfil, 1, h(kev+1,kev), ndigit, & '_napps: betak = e_{kev+1}^T*H*e_{kev}') - call pivout (comm, logfil, 1, kev, ndigit, + call pivout (comm, logfil, 1, [kev], ndigit, & '_napps: Order of the final Hessenberg matrix ') if (msglvl .gt. 2) then call psmout (comm, logfil, kev, kev, h, ldh, ndigit, diff -Nru arpack-3.7.0/PARPACK/SRC/MPI/psnaup2.f arpack-3.8.0/PARPACK/SRC/MPI/psnaup2.f --- arpack-3.7.0/PARPACK/SRC/MPI/psnaup2.f 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/PARPACK/SRC/MPI/psnaup2.f 2020-12-07 10:40:45.000000000 +0000 @@ -241,7 +241,7 @@ c Real - & rnorm_buf + & rnorm_buf, buf2(1) c c %-----------------------% c | Local array arguments | @@ -408,7 +408,7 @@ iter = iter + 1 c if (msglvl .gt. 0) then - call pivout (comm, logfil, 1, iter, ndigit, + call pivout (comm, logfil, 1, [iter], ndigit, & '_naup2: **** Start of major iteration number ****') end if c @@ -421,9 +421,9 @@ np = kplusp - nev c if (msglvl .gt. 1) then - call pivout (comm, logfil, 1, nev, ndigit, + call pivout (comm, logfil, 1, [nev], ndigit, & '_naup2: The length of the current Arnoldi factorization') - call pivout (comm, logfil, 1, np, ndigit, + call pivout (comm, logfil, 1, [np], ndigit, & '_naup2: Extend the Arnoldi factorization by') end if c @@ -455,7 +455,7 @@ update = .false. c if (msglvl .gt. 1) then - call psvout (comm, logfil, 1, rnorm, ndigit, + call psvout (comm, logfil, 1, [rnorm], ndigit, & '_naup2: Corresponding B-norm of the residual') end if c @@ -699,7 +699,7 @@ end if c if (msglvl .gt. 0) then - call pivout (comm, logfil, 1, nconv, ndigit, + call pivout (comm, logfil, 1, [nconv], ndigit, & '_naup2: no. of "converged" Ritz values at this iter.') if (msglvl .gt. 1) then kp(1) = nev @@ -751,7 +751,7 @@ end if c if (msglvl .gt. 2) then - call pivout (comm, logfil, 1, np, ndigit, + call pivout (comm, logfil, 1, [np], ndigit, & '_naup2: The number of shifts to apply ') call psvout (comm, logfil, np, ritzr, ndigit, & '_naup2: Real part of the shifts') @@ -810,16 +810,16 @@ c if (bmat .eq. 'G') then rnorm_buf = sdot (n, resid, 1, workd, 1) - call MPI_ALLREDUCE( rnorm_buf, rnorm, 1, + call MPI_ALLREDUCE( [rnorm_buf], buf2, 1, & MPI_REAL, MPI_SUM, comm, ierr ) - rnorm = sqrt(abs(rnorm)) + rnorm = sqrt(abs(buf2(1))) else if (bmat .eq. 'I') then rnorm = psnorm2( comm, n, resid, 1 ) end if cnorm = .false. c if (msglvl .gt. 2) then - call psvout (comm, logfil, 1, rnorm, ndigit, + call psvout (comm, logfil, 1, [rnorm], ndigit, & '_naup2: B-norm of residual for compressed factorization') call psmout (comm, logfil, nev, nev, h, ldh, ndigit, & '_naup2: Compressed upper Hessenberg matrix H') diff -Nru arpack-3.7.0/PARPACK/SRC/MPI/psnaupd.f arpack-3.8.0/PARPACK/SRC/MPI/psnaupd.f --- arpack-3.7.0/PARPACK/SRC/MPI/psnaupd.f 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/PARPACK/SRC/MPI/psnaupd.f 2020-12-07 10:40:45.000000000 +0000 @@ -650,9 +650,9 @@ if (info .eq. 2) info = 3 c if (msglvl .gt. 0) then - call pivout (comm, logfil, 1, mxiter, ndigit, + call pivout (comm, logfil, 1, [mxiter], ndigit, & '_naupd: Number of update iterations taken') - call pivout (comm, logfil, 1, np, ndigit, + call pivout (comm, logfil, 1, [np], ndigit, & '_naupd: Number of wanted "converged" Ritz values') call psvout (comm, logfil, np, workl(ritzr), ndigit, & '_naupd: Real part of the final Ritz values') diff -Nru arpack-3.7.0/PARPACK/SRC/MPI/psneupd.f arpack-3.8.0/PARPACK/SRC/MPI/psneupd.f --- arpack-3.7.0/PARPACK/SRC/MPI/psneupd.f 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/PARPACK/SRC/MPI/psneupd.f 2020-12-07 10:40:45.000000000 +0000 @@ -617,9 +617,9 @@ c %-----------------------------------------------------------% c if (msglvl .gt. 2) then - call pivout(comm, logfil, 1, numcnv, ndigit, + call pivout(comm, logfil, 1, [numcnv], ndigit, & '_neupd: Number of specified eigenvalues') - call pivout(comm, logfil, 1, nconv, ndigit, + call pivout(comm, logfil, 1, [nconv], ndigit, & '_neupd: Number of "converged" eigenvalues') end if c diff -Nru arpack-3.7.0/PARPACK/SRC/MPI/psngets.f arpack-3.8.0/PARPACK/SRC/MPI/psngets.f --- arpack-3.7.0/PARPACK/SRC/MPI/psngets.f 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/PARPACK/SRC/MPI/psngets.f 2020-12-07 10:40:45.000000000 +0000 @@ -226,8 +226,8 @@ tngets = tngets + (t1 - t0) c if (msglvl .gt. 0) then - call pivout (comm, logfil, 1, kev, ndigit, '_ngets: KEV is') - call pivout (comm, logfil, 1, np, ndigit, '_ngets: NP is') + call pivout (comm, logfil, 1, [kev], ndigit, '_ngets: KEV is') + call pivout (comm, logfil, 1, [np], ndigit, '_ngets: NP is') call psvout (comm, logfil, kev+np, ritzr, ndigit, & '_ngets: Eigenvalues of current H matrix -- real part') call psvout (comm, logfil, kev+np, ritzi, ndigit, diff -Nru arpack-3.7.0/PARPACK/SRC/MPI/psnorm2.f arpack-3.8.0/PARPACK/SRC/MPI/psnorm2.f --- arpack-3.7.0/PARPACK/SRC/MPI/psnorm2.f 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/PARPACK/SRC/MPI/psnorm2.f 2020-12-07 10:40:45.000000000 +0000 @@ -45,7 +45,7 @@ c %---------------% c Real - & max, buf, zero + & max, buf, zero, buf2(1) parameter ( zero = 0.0 ) c c %---------------------% @@ -69,15 +69,16 @@ psnorm2 = snrm2( n, x, inc) c buf = psnorm2 - call MPI_ALLREDUCE( buf, max, 1, MPI_REAL, + call MPI_ALLREDUCE( [buf], buf2, 1, MPI_REAL, & MPI_MAX, comm, ierr ) + max = buf2(1) if ( max .eq. zero ) then psnorm2 = zero else buf = (psnorm2/max)**2.0 - call MPI_ALLREDUCE( buf, psnorm2, 1, MPI_REAL, + call MPI_ALLREDUCE( [buf], buf2, 1, MPI_REAL, & MPI_SUM, comm, ierr ) - psnorm2 = max * sqrt(abs(psnorm2)) + psnorm2 = max * sqrt(abs(buf2(1))) endif c c %----------------% diff -Nru arpack-3.7.0/PARPACK/SRC/MPI/pssaitr.f arpack-3.8.0/PARPACK/SRC/MPI/pssaitr.f --- arpack-3.7.0/PARPACK/SRC/MPI/pssaitr.f 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/PARPACK/SRC/MPI/pssaitr.f 2020-12-07 10:40:45.000000000 +0000 @@ -264,7 +264,7 @@ integer i, ierr, ipj, irj, ivj, iter, itry, j, msglvl, infol, & jj Real - & rnorm1, wnorm, safmin, temp1 + & rnorm1, wnorm(1), safmin, temp1, temp2(1) save orth1, orth2, rstart, step3, step4, & ierr, ipj, irj, ivj, iter, itry, j, msglvl, & rnorm1, safmin, wnorm @@ -392,9 +392,9 @@ 1000 continue c if (msglvl .gt. 2) then - call pivout (comm, logfil, 1, j, ndigit, + call pivout (comm, logfil, 1, [j], ndigit, & '_saitr: generating Arnoldi vector no.') - call psvout (comm, logfil, 1, rnorm, ndigit, + call psvout (comm, logfil, 1, [rnorm], ndigit, & '_saitr: B-norm of the current residual =') end if c @@ -412,7 +412,7 @@ c %---------------------------------------------------% c if (msglvl .gt. 0) then - call pivout (comm, logfil, 1, j, ndigit, + call pivout (comm, logfil, 1, [j], ndigit, & '_saitr: ****** restart at step ******') end if c @@ -572,16 +572,16 @@ c %----------------------------------% c rnorm_buf = sdot (n, resid, 1, workd(ivj), 1) - call MPI_ALLREDUCE( rnorm_buf, wnorm, 1, + call MPI_ALLREDUCE( [rnorm_buf], wnorm, 1, & MPI_REAL, MPI_SUM, comm, ierr ) - wnorm = sqrt(abs(wnorm)) + wnorm(1) = sqrt(abs(wnorm(1))) else if (bmat .eq. 'G') then rnorm_buf = sdot (n, resid, 1, workd(ipj), 1) - call MPI_ALLREDUCE( rnorm_buf, wnorm, 1, + call MPI_ALLREDUCE( [rnorm_buf], wnorm, 1, & MPI_REAL, MPI_SUM, comm, ierr ) wnorm = sqrt(abs(wnorm)) else if (bmat .eq. 'I') then - wnorm = psnorm2( comm, n, resid, 1 ) + wnorm(1) = psnorm2( comm, n, resid, 1 ) end if c c %-----------------------------------------% @@ -669,9 +669,9 @@ c if (bmat .eq. 'G') then rnorm_buf = sdot (n, resid, 1, workd(ipj), 1) - call MPI_ALLREDUCE( rnorm_buf, rnorm, 1, + call MPI_ALLREDUCE( [rnorm_buf], temp2, 1, & MPI_REAL, MPI_SUM, comm, ierr ) - rnorm = sqrt(abs(rnorm)) + rnorm = sqrt(abs(temp2(1))) else if (bmat .eq. 'I') then rnorm = psnorm2( comm, n, resid, 1 ) end if @@ -691,7 +691,7 @@ c | to enforce ||v(:,1:j)^T * r_{j}|| .le. eps * || r_{j} || | c %-----------------------------------------------------------% c - if (rnorm .gt. 0.717*wnorm) go to 100 + if (rnorm .gt. 0.717*wnorm(1)) go to 100 nrorth = nrorth + 1 c c %---------------------------------------------------% @@ -704,7 +704,7 @@ 80 continue c if (msglvl .gt. 2) then - xtemp(1) = wnorm + xtemp(1) = wnorm(1) xtemp(2) = rnorm call psvout (comm, logfil, 2, xtemp, ndigit, & '_naitr: re-orthonalization ; wnorm and rnorm are') @@ -769,15 +769,15 @@ c if (bmat .eq. 'G') then rnorm_buf = sdot (n, resid, 1, workd(ipj), 1) - call MPI_ALLREDUCE( rnorm_buf, rnorm1, 1, + call MPI_ALLREDUCE( [rnorm_buf], temp2, 1, & MPI_REAL, MPI_SUM, comm, ierr ) - rnorm1 = sqrt(abs(rnorm1)) + rnorm1 = sqrt(abs(temp2(1))) else if (bmat .eq. 'I') then rnorm1 = psnorm2( comm, n, resid, 1 ) end if c if (msglvl .gt. 0 .and. iter .gt. 0) then - call pivout (comm, logfil, 1, j, ndigit, + call pivout (comm, logfil, 1, [j], ndigit, & '_naitr: Iterative refinement for Arnoldi residual') if (msglvl .gt. 2) then xtemp(1) = rnorm diff -Nru arpack-3.7.0/PARPACK/SRC/MPI/pssapps.f arpack-3.8.0/PARPACK/SRC/MPI/pssapps.f --- arpack-3.7.0/PARPACK/SRC/MPI/pssapps.f 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/PARPACK/SRC/MPI/pssapps.f 2020-12-07 10:40:45.000000000 +0000 @@ -271,9 +271,9 @@ big = abs(h(i,2)) + abs(h(i+1,2)) if (h(i+1,1) .le. epsmch*big) then if (msglvl .gt. 0) then - call pivout (comm, logfil, 1, i, ndigit, + call pivout (comm, logfil, 1, [i], ndigit, & '_sapps: deflation at row/column no.') - call pivout (comm, logfil, 1, jj, ndigit, + call pivout (comm, logfil, 1, [jj], ndigit, & '_sapps: occurred before shift number.') call psvout (comm, logfil, 1, h(i+1,1), ndigit, & '_sapps: the corresponding off diagonal element') @@ -442,7 +442,7 @@ big = abs(h(i,2)) + abs(h(i+1,2)) if (h(i+1,1) .le. epsmch*big) then if (msglvl .gt. 0) then - call pivout (comm, logfil, 1, i, ndigit, + call pivout (comm, logfil, 1, [i], ndigit, & '_sapps: deflation at row/column no.') call psvout (comm, logfil, 1, h(i+1,1), ndigit, & '_sapps: the corresponding off diagonal element') diff -Nru arpack-3.7.0/PARPACK/SRC/MPI/pssaup2.f arpack-3.8.0/PARPACK/SRC/MPI/pssaup2.f --- arpack-3.7.0/PARPACK/SRC/MPI/pssaup2.f 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/PARPACK/SRC/MPI/pssaup2.f 2020-12-07 10:40:45.000000000 +0000 @@ -241,7 +241,7 @@ integer ierr, iter, j, kplusp, msglvl, nconv, nevbef, nev0, & np0, nptemp, nevd2, nevm2, kp(3) Real - & rnorm, temp, eps23 + & rnorm, temp, eps23, buf2(1) save cnorm, getv0, initv, update, ushift, & iter, kplusp, msglvl, nconv, nev0, np0, & rnorm, eps23 @@ -424,13 +424,13 @@ iter = iter + 1 c if (msglvl .gt. 0) then - call pivout (comm, logfil, 1, iter, ndigit, + call pivout (comm, logfil, 1, [iter], ndigit, & '_saup2: **** Start of major iteration number ****') end if if (msglvl .gt. 1) then - call pivout (comm, logfil, 1, nev, ndigit, + call pivout (comm, logfil, 1, [nev], ndigit, & '_saup2: The length of the current Lanczos factorization') - call pivout (comm, logfil, 1, np, ndigit, + call pivout (comm, logfil, 1, [np], ndigit, & '_saup2: Extend the Lanczos factorization by') end if c @@ -469,7 +469,7 @@ update = .false. c if (msglvl .gt. 1) then - call psvout (comm, logfil, 1, rnorm, ndigit, + call psvout (comm, logfil, 1, [rnorm], ndigit, & '_saup2: Current B-norm of residual for factorization') end if c @@ -719,7 +719,7 @@ end if c if (msglvl .gt. 0) then - call pivout (comm, logfil, 1, nconv, ndigit, + call pivout (comm, logfil, 1, [nconv], ndigit, & '_saup2: no. of "converged" Ritz values at this iter.') if (msglvl .gt. 1) then kp(1) = nev @@ -766,7 +766,7 @@ if (ishift .eq. 0) call scopy (np, workl, 1, ritz, 1) c if (msglvl .gt. 2) then - call pivout (comm, logfil, 1, np, ndigit, + call pivout (comm, logfil, 1, [np], ndigit, & '_saup2: The number of shifts to apply ') call psvout (comm, logfil, np, workl, ndigit, & '_saup2: shifts selected') @@ -825,9 +825,9 @@ c if (bmat .eq. 'G') then rnorm_buf = sdot (n, resid, 1, workd, 1) - call MPI_ALLREDUCE( rnorm_buf, rnorm, 1, + call MPI_ALLREDUCE( [rnorm_buf], buf2, 1, & MPI_REAL, MPI_SUM, comm, ierr ) - rnorm = sqrt(abs(rnorm)) + rnorm = sqrt(abs(buf2(1))) else if (bmat .eq. 'I') then rnorm = psnorm2( comm, n, resid, 1 ) end if @@ -835,7 +835,7 @@ 130 continue c if (msglvl .gt. 2) then - call psvout (comm, logfil, 1, rnorm, ndigit, + call psvout (comm, logfil, 1, [rnorm], ndigit, & '_saup2: B-norm of residual for NEV factorization') call psvout (comm, logfil, nev, h(1,2), ndigit, & '_saup2: main diagonal of compressed H matrix') diff -Nru arpack-3.7.0/PARPACK/SRC/MPI/pssaupd.f arpack-3.8.0/PARPACK/SRC/MPI/pssaupd.f --- arpack-3.7.0/PARPACK/SRC/MPI/pssaupd.f 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/PARPACK/SRC/MPI/pssaupd.f 2020-12-07 10:40:45.000000000 +0000 @@ -652,9 +652,9 @@ if (info .eq. 2) info = 3 c if (msglvl .gt. 0) then - call pivout (comm, logfil, 1, mxiter, ndigit, + call pivout (comm, logfil, 1, [mxiter], ndigit, & '_saupd: number of update iterations taken') - call pivout (comm, logfil, 1, np, ndigit, + call pivout (comm, logfil, 1, [np], ndigit, & '_saupd: number of "converged" Ritz values') call psvout (comm, logfil, np, workl(Ritz), ndigit, & '_saupd: final Ritz values') diff -Nru arpack-3.7.0/PARPACK/SRC/MPI/psseupd.f arpack-3.8.0/PARPACK/SRC/MPI/psseupd.f --- arpack-3.7.0/PARPACK/SRC/MPI/psseupd.f 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/PARPACK/SRC/MPI/psseupd.f 2020-12-07 10:40:45.000000000 +0000 @@ -523,9 +523,9 @@ c %-----------------------------------------------------------% c if (msglvl .gt. 2) then - call pivout(comm, logfil, 1, numcnv, ndigit, + call pivout(comm, logfil, 1, [numcnv], ndigit, & '_neupd: Number of specified eigenvalues') - call pivout(comm, logfil, 1, nconv, ndigit, + call pivout(comm, logfil, 1, [nconv], ndigit, & '_neupd: Number of "converged" eigenvalues') end if c diff -Nru arpack-3.7.0/PARPACK/SRC/MPI/pssgets.f arpack-3.8.0/PARPACK/SRC/MPI/pssgets.f --- arpack-3.7.0/PARPACK/SRC/MPI/pssgets.f 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/PARPACK/SRC/MPI/pssgets.f 2020-12-07 10:40:45.000000000 +0000 @@ -216,8 +216,8 @@ tsgets = tsgets + (t1 - t0) c if (msglvl .gt. 0) then - call pivout (comm, logfil, 1, kev, ndigit, '_sgets: KEV is') - call pivout (comm, logfil, 1, np, ndigit, '_sgets: NP is') + call pivout (comm, logfil, 1, [kev], ndigit, '_sgets: KEV is') + call pivout (comm, logfil, 1, [np], ndigit, '_sgets: NP is') call psvout (comm, logfil, kev+np, ritz, ndigit, & '_sgets: Eigenvalues of current H matrix') call psvout (comm, logfil, kev+np, bounds, ndigit, diff -Nru arpack-3.7.0/PARPACK/SRC/MPI/pzgetv0.f arpack-3.8.0/PARPACK/SRC/MPI/pzgetv0.f --- arpack-3.7.0/PARPACK/SRC/MPI/pzgetv0.f 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/PARPACK/SRC/MPI/pzgetv0.f 2020-12-07 10:40:45.000000000 +0000 @@ -185,7 +185,7 @@ save first, iseed, inits, iter, msglvl, orth, rnorm0 c Complex*16 - & cnorm_buf + & cnorm_buf, buf2(1) c c %----------------------% c | External Subroutines | @@ -332,8 +332,9 @@ first = .FALSE. if (bmat .eq. 'G') then cnorm_buf = zdotc (n, resid, 1, workd, 1) - call MPI_ALLREDUCE( cnorm_buf, cnorm, 1, + call MPI_ALLREDUCE( [cnorm_buf], buf2, 1, & MPI_DOUBLE_COMPLEX , MPI_SUM, comm, ierr ) + cnorm = buf2(1) rnorm0 = sqrt(dlapy2 (dble (cnorm),dimag (cnorm))) else if (bmat .eq. 'I') then rnorm0 = pdznorm2 ( comm, n, resid, 1) @@ -393,8 +394,9 @@ c if (bmat .eq. 'G') then cnorm_buf = zdotc (n, resid, 1, workd, 1) - call MPI_ALLREDUCE( cnorm_buf, cnorm, 1, + call MPI_ALLREDUCE( [cnorm_buf], buf2, 1, & MPI_DOUBLE_COMPLEX , MPI_SUM, comm, ierr ) + cnorm = buf2(1) rnorm = sqrt(dlapy2 (dble (cnorm),dimag (cnorm))) else if (bmat .eq. 'I') then rnorm = pdznorm2 (comm, n, resid, 1) @@ -405,9 +407,9 @@ c %--------------------------------------% c if (msglvl .gt. 2) then - call pdvout (comm, logfil, 1, rnorm0, ndigit, + call pdvout (comm, logfil, 1, [rnorm0], ndigit, & '_getv0: re-orthonalization ; rnorm0 is') - call pdvout (comm, logfil, 1, rnorm, ndigit, + call pdvout (comm, logfil, 1, [rnorm], ndigit, & '_getv0: re-orthonalization ; rnorm is') end if c @@ -439,7 +441,7 @@ c if (msglvl .gt. 0) then cnorm2 = dcmplx (rnorm,rzero) - call pzvout (comm, logfil, 1, cnorm2, ndigit, + call pzvout (comm, logfil, 1, [cnorm2], ndigit, & '_getv0: B-norm of initial / restarted starting vector') end if if (msglvl .gt. 2) then diff -Nru arpack-3.7.0/PARPACK/SRC/MPI/pznaitr.f arpack-3.8.0/PARPACK/SRC/MPI/pznaitr.f --- arpack-3.7.0/PARPACK/SRC/MPI/pznaitr.f 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/PARPACK/SRC/MPI/pznaitr.f 2020-12-07 10:40:45.000000000 +0000 @@ -293,7 +293,7 @@ & betaj, rnorm1, smlnum, ulp, unfl, wnorm c Complex*16 - & cnorm_buf + & cnorm_buf, buf2(1) c c %----------------------% c | External Subroutines | @@ -404,9 +404,9 @@ 1000 continue c if (msglvl .gt. 1) then - call pivout (comm, logfil, 1, j, ndigit, + call pivout (comm, logfil, 1, [j], ndigit, & '_naitr: generating Arnoldi vector number') - call pzvout (comm, logfil, 1, rnorm, ndigit, + call pdvout (comm, logfil, 1, [rnorm], ndigit, & '_naitr: B-norm of the current residual is') end if c @@ -426,7 +426,7 @@ c %---------------------------------------------------% c if (msglvl .gt. 0) then - call pivout (comm, logfil, 1, j, ndigit, + call pivout (comm, logfil, 1, [j], ndigit, & '_naitr: ****** RESTART AT STEP ******') end if c @@ -577,9 +577,10 @@ c if (bmat .eq. 'G') then cnorm_buf = zdotc (n, resid, 1, workd(ipj), 1) - call MPI_ALLREDUCE( cnorm_buf, cnorm, 1, + call MPI_ALLREDUCE( [cnorm_buf], buf2, 1, & MPI_DOUBLE_COMPLEX, MPI_SUM, comm, ierr ) - wnorm = sqrt( dlapy2(dble(cnorm),dimag(cnorm)) ) + cnorm = buf2(1) + wnorm = sqrt( dlapy2(dble(cnorm),dimag(cnorm)) ) else if (bmat .eq. 'I') then wnorm = pdznorm2(comm, n, resid, 1) end if @@ -653,8 +654,9 @@ c if (bmat .eq. 'G') then cnorm_buf = zdotc (n, resid, 1, workd(ipj), 1) - call MPI_ALLREDUCE( cnorm_buf, cnorm, 1, + call MPI_ALLREDUCE( [cnorm_buf], buf2, 1, & MPI_DOUBLE_COMPLEX, MPI_SUM, comm, ierr ) + cnorm = buf2(1) rnorm = sqrt( dlapy2(dble(cnorm),dimag(cnorm)) ) else if (bmat .eq. 'I') then rnorm = pdznorm2(comm, n, resid, 1) @@ -757,15 +759,16 @@ c if (bmat .eq. 'G') then cnorm_buf = zdotc (n, resid, 1, workd(ipj), 1) - call MPI_ALLREDUCE( cnorm_buf, cnorm, 1, + call MPI_ALLREDUCE( [cnorm_buf], buf2, 1, & MPI_DOUBLE_COMPLEX, MPI_SUM, comm, ierr ) - rnorm1 = sqrt( dlapy2(dble(cnorm),dimag(cnorm)) ) + cnorm = buf2(1) + rnorm1 = sqrt( dlapy2(dble(cnorm),dimag(cnorm)) ) else if (bmat .eq. 'I') then rnorm1 = pdznorm2(comm, n, resid, 1) end if c if (msglvl .gt. 0 .and. iter .gt. 0 ) then - call pivout (comm, logfil, 1, j, ndigit, + call pivout (comm, logfil, 1, [j], ndigit, & '_naitr: Iterative refinement for Arnoldi residual') if (msglvl .gt. 2) then rtemp(1) = rnorm diff -Nru arpack-3.7.0/PARPACK/SRC/MPI/pznapps.f arpack-3.8.0/PARPACK/SRC/MPI/pznapps.f --- arpack-3.7.0/PARPACK/SRC/MPI/pznapps.f 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/PARPACK/SRC/MPI/pznapps.f 2020-12-07 10:40:45.000000000 +0000 @@ -283,9 +283,9 @@ sigma = shift(jj) c if (msglvl .gt. 2 ) then - call pivout (comm, logfil, 1, jj, ndigit, + call pivout (comm, logfil, 1, [jj], ndigit, & '_napps: shift number.') - call pzvout (comm, logfil, 1, sigma, ndigit, + call pzvout (comm, logfil, 1, [sigma], ndigit, & '_napps: Value of the shift ') end if c @@ -306,9 +306,9 @@ if ( abs(dble(h(i+1,i))) & .le. max(ulp*tst1, smlnum) ) then if (msglvl .gt. 0) then - call pivout (comm, logfil, 1, i, ndigit, + call pivout (comm, logfil, 1, [i], ndigit, & '_napps: matrix splitting at row/column no.') - call pivout (comm, logfil, 1, jj, ndigit, + call pivout (comm, logfil, 1, [jj], ndigit, & '_napps: matrix splitting with shift number.') call pzvout (comm, logfil, 1, h(i+1,i), ndigit, & '_napps: off diagonal element.') @@ -322,9 +322,9 @@ 40 continue c if (msglvl .gt. 2) then - call pivout (comm, logfil, 1, istart, ndigit, + call pivout (comm, logfil, 1, [istart], ndigit, & '_napps: Start of current block ') - call pivout (comm, logfil, 1, iend, ndigit, + call pivout (comm, logfil, 1, [iend], ndigit, & '_napps: End of current block ') end if c @@ -500,7 +500,7 @@ & '_napps: sigmak = (e_{kev+p}^T*Q)*e_{kev}') call pzvout (comm, logfil, 1, h(kev+1,kev), ndigit, & '_napps: betak = e_{kev+1}^T*H*e_{kev}') - call pivout (comm, logfil, 1, kev, ndigit, + call pivout (comm, logfil, 1, [kev], ndigit, & '_napps: Order of the final Hessenberg matrix ') if (msglvl .gt. 2) then call pzmout (comm, logfil, kev, kev, h, ldh, ndigit, diff -Nru arpack-3.7.0/PARPACK/SRC/MPI/pznaup2.f arpack-3.8.0/PARPACK/SRC/MPI/pznaup2.f --- arpack-3.7.0/PARPACK/SRC/MPI/pznaup2.f 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/PARPACK/SRC/MPI/pznaup2.f 2020-12-07 10:40:45.000000000 +0000 @@ -237,7 +237,7 @@ & nevbef, nev0 , np0, eps23 c Double precision - & cmpnorm_buf + & cmpnorm_buf, buf2(1) c c %-----------------------% c | Local array arguments | @@ -401,7 +401,7 @@ iter = iter + 1 c if (msglvl .gt. 0) then - call pivout (comm, logfil, 1, iter, ndigit, + call pivout (comm, logfil, 1, [iter], ndigit, & '_naup2: **** Start of major iteration number ****') end if c @@ -414,9 +414,9 @@ np = kplusp - nev c if (msglvl .gt. 1) then - call pivout (comm, logfil, 1, nev, ndigit, + call pivout (comm, logfil, 1, [nev], ndigit, & '_naup2: The length of the current Arnoldi factorization') - call pivout (comm, logfil, 1, np, ndigit, + call pivout (comm, logfil, 1, [np], ndigit, & '_naup2: Extend the Arnoldi factorization by') end if c @@ -443,7 +443,7 @@ update = .false. c if (msglvl .gt. 1) then - call pdvout (comm, logfil, 1, rnorm, ndigit, + call pdvout (comm, logfil, 1, [rnorm], ndigit, & '_naup2: Corresponding B-norm of the residual') end if c @@ -674,7 +674,7 @@ end if c if (msglvl .gt. 0) then - call pivout (comm, logfil, 1, nconv, ndigit, + call pivout (comm, logfil, 1, [nconv], ndigit, & '_naup2: no. of "converged" Ritz values at this iter.') if (msglvl .gt. 1) then kp(1) = nev @@ -714,7 +714,7 @@ end if c if (msglvl .gt. 2) then - call pivout (comm, logfil, 1, np, ndigit, + call pivout (comm, logfil, 1, [np], ndigit, & '_naup2: The number of shifts to apply ') call pzvout (comm, logfil, np, ritz, ndigit, & '_naup2: values of the shifts') @@ -771,8 +771,9 @@ c if (bmat .eq. 'G') then cmpnorm_buf = zdotc (n, resid, 1, workd, 1) - call MPI_ALLREDUCE( cmpnorm_buf, cmpnorm, 1, + call MPI_ALLREDUCE( [cmpnorm_buf], buf2, 1, & MPI_DOUBLE_COMPLEX, MPI_SUM, comm, ierr ) + cmpnorm = buf2(1) rnorm = sqrt(dlapy2(dble(cmpnorm),dimag(cmpnorm))) else if (bmat .eq. 'I') then rnorm = pdznorm2(comm, n, resid, 1) @@ -780,7 +781,7 @@ cnorm = .false. c if (msglvl .gt. 2) then - call pdvout (comm, logfil, 1, rnorm, ndigit, + call pdvout (comm, logfil, 1, [rnorm], ndigit, & '_naup2: B-norm of residual for compressed factorization') call pzmout (comm, logfil, nev, nev, h, ldh, ndigit, & '_naup2: Compressed upper Hessenberg matrix H') diff -Nru arpack-3.7.0/PARPACK/SRC/MPI/pznaupd.f arpack-3.8.0/PARPACK/SRC/MPI/pznaupd.f --- arpack-3.7.0/PARPACK/SRC/MPI/pznaupd.f 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/PARPACK/SRC/MPI/pznaupd.f 2020-12-07 10:40:45.000000000 +0000 @@ -626,9 +626,9 @@ if (info .eq. 2) info = 3 c if (msglvl .gt. 0) then - call pivout (comm, logfil, 1, mxiter, ndigit, + call pivout (comm, logfil, 1, [mxiter], ndigit, & '_naupd: Number of update iterations taken') - call pivout (comm, logfil, 1, np, ndigit, + call pivout (comm, logfil, 1, [np], ndigit, & '_naupd: Number of wanted "converged" Ritz values') call pzvout (comm, logfil, np, workl(ritz), ndigit, & '_naupd: The final Ritz values') diff -Nru arpack-3.7.0/PARPACK/SRC/MPI/pzneupd.f arpack-3.8.0/PARPACK/SRC/MPI/pzneupd.f --- arpack-3.7.0/PARPACK/SRC/MPI/pzneupd.f 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/PARPACK/SRC/MPI/pzneupd.f 2020-12-07 10:40:45.000000000 +0000 @@ -558,9 +558,9 @@ c %-----------------------------------------------------------% c if (msglvl .gt. 2) then - call pivout(comm, logfil, 1, numcnv, ndigit, + call pivout(comm, logfil, 1, [numcnv], ndigit, & '_neupd: Number of specified eigenvalues') - call pivout(comm, logfil, 1, nconv, ndigit, + call pivout(comm, logfil, 1, [nconv], ndigit, & '_neupd: Number of "converged" eigenvalues') end if c diff -Nru arpack-3.7.0/PARPACK/SRC/MPI/pzngets.f arpack-3.8.0/PARPACK/SRC/MPI/pzngets.f --- arpack-3.7.0/PARPACK/SRC/MPI/pzngets.f 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/PARPACK/SRC/MPI/pzngets.f 2020-12-07 10:40:45.000000000 +0000 @@ -177,8 +177,8 @@ tcgets = tcgets + (t1 - t0) c if (msglvl .gt. 0) then - call pivout (comm, logfil, 1, kev, ndigit, '_ngets: KEV is') - call pivout (comm, logfil, 1, np, ndigit, '_ngets: NP is') + call pivout (comm, logfil, 1, [kev], ndigit, '_ngets: KEV is') + call pivout (comm, logfil, 1, [np], ndigit, '_ngets: NP is') call pzvout (comm, logfil, kev+np, ritz, ndigit, & '_ngets: Eigenvalues of current H matrix ') call pzvout (comm, logfil, kev+np, bounds, ndigit, diff -Nru arpack-3.7.0/PARPACK/TESTS/MPI/icb_parpack_c.c arpack-3.8.0/PARPACK/TESTS/MPI/icb_parpack_c.c --- arpack-3.7.0/PARPACK/TESTS/MPI/icb_parpack_c.c 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/PARPACK/TESTS/MPI/icb_parpack_c.c 2020-12-07 10:40:45.000000000 +0000 @@ -1,31 +1,31 @@ /* - * This example demonstrates the use of ISO_C_BINDING to call arpack (portability). - * IMPORTANT: MPI communicators MUST be passed from C to Fortran using MPI_Comm_c2f. + * This example demonstrates the use of ISO_C_BINDING to call arpack + * (portability). IMPORTANT: MPI communicators MUST be passed from C to Fortran + * using MPI_Comm_c2f. * - * Just use arpack as you would have normally done, but, use *[ae]upd_c instead of *[ae]upd_. - * The main advantage is that compiler checks (arguments) are performed at build time. - * Note: to debug parpack, call debug_c. + * Just use arpack as you would have normally done, but, use *[ae]upd_c instead + * of *[ae]upd_. The main advantage is that compiler checks (arguments) are + * performed at build time. Note: to debug parpack, call debug_c. */ +#include // creal, cimag. +#include #include #include -#include -#include // bool. + +#include "debug_c.h" // debug parpack. #include "mpi.h" #include "parpack.h" -#include // creal, cimag. -#include "debug_c.h" // debug parpack. -#include "stat_c.h" // arpack statistics. +#include "stat_c.h" // arpack statistics. /* test program to solve for the 9 largest eigenvalues of * A*x = lambda*x where A is the diagonal matrix * with entries 1000, 999, ... , 2, 1 on the diagonal. * */ -void dMatVec(double * x, double * y) { +void dMatVec(double* x, double* y) { int i; - for ( i = 0; i < 1000; ++i) - y[i] = ((double) (i+1))*x[i]; + for (i = 0; i < 1000; ++i) y[i] = ((double)(i + 1)) * x[i]; }; int ds() { @@ -34,55 +34,60 @@ a_int N = 1000; char which[] = "LM"; a_int nev = 3; - double tol = 0; + double tol = 0.000001; // small tol => more stable checks after EV computation. double resid[N]; - a_int ncv = 2*nev+1; - double V[ncv*N]; + a_int ncv = 2 * nev + 1; + double V[ncv * N]; a_int ldv = N; a_int iparam[11]; a_int ipntr[14]; - double workd[3*N]; - bool rvec = true; + double workd[3 * N]; + a_int rvec = 1; char howmny[] = "A"; - double* d = (double*) malloc((nev+1)*sizeof(double)); + double* d = (double*)malloc((nev + 1) * sizeof(double)); a_int select[ncv]; - double z[(N+1)*(nev+1)]; - a_int ldz = N+1; - double sigma=0; + for (int i = 0; i < ncv; i++) select[i] = 1; + double z[(N + 1) * (nev + 1)]; + a_int ldz = N + 1; + double sigma = 0; int k; - for (k=0; k < 3*N; ++k ) - workd[k] = 0; - double workl[3*(ncv*ncv) + 6*ncv]; - for (k=0; k < 3*(ncv*ncv) + 6*ncv; ++k ) - workl[k] = 0; - a_int lworkl = 3*(ncv*ncv) + 6*ncv; + for (k = 0; k < 3 * N; ++k) workd[k] = 0; + double workl[3 * (ncv * ncv) + 6 * ncv]; + for (k = 0; k < 3 * (ncv * ncv) + 6 * ncv; ++k) workl[k] = 0; + a_int lworkl = 3 * (ncv * ncv) + 6 * ncv; a_int info = 0; - int rank; MPI_Comm_rank(MPI_COMM_WORLD, &rank); + int rank; + MPI_Comm_rank(MPI_COMM_WORLD, &rank); iparam[0] = 1; - iparam[2] = 10*N; + iparam[2] = 10 * N; iparam[3] = 1; - iparam[4] = 0; // number of ev found by arpack. + iparam[4] = 0; // number of ev found by arpack. iparam[6] = 1; MPI_Fint MCW = MPI_Comm_c2f(MPI_COMM_WORLD); - while(ido != 99) { + while (ido != 99) { /* call arpack like you would have, but, use dsaupd_c instead of dsaupd_ */ - pdsaupd_c(MCW, &ido, bmat, N, which, nev, tol, resid, ncv, V, ldv, iparam, ipntr, - workd, workl, lworkl, &info); + pdsaupd_c(MCW, &ido, bmat, N, which, nev, tol, resid, ncv, V, ldv, iparam, + ipntr, workd, workl, lworkl, &info); - dMatVec(&(workd[ipntr[0]-1]), &(workd[ipntr[1]-1])); + dMatVec(&(workd[ipntr[0] - 1]), &(workd[ipntr[1] - 1])); } - if (iparam[4] != nev) return 1; // check number of ev found by arpack. + if (iparam[4] != nev) {printf("Error: iparam[4] %d, nev %d\n", iparam[4], nev); return 1;} // check number of ev found by arpack. /* call arpack like you would have, but, use dseupd_c instead of dseupd_ */ - pdseupd_c(MCW, rvec, howmny, select, d, z, ldz, sigma, - bmat, N, which, nev, tol, resid, ncv, V, ldv, iparam, ipntr, - workd, workl, lworkl, &info); + pdseupd_c(MCW, rvec, howmny, select, d, z, ldz, sigma, bmat, N, which, nev, + tol, resid, ncv, V, ldv, iparam, ipntr, workd, workl, lworkl, + &info); int i; for (i = 0; i < nev; ++i) { - printf("rank %d - %f\n", rank, d[i]); - if(fabs(d[i] - (double)(1000-(nev-1)+i))>1e-6){ + double val = d[i]; + double ref = (N-(nev-1)+i); + double eps = fabs(val - ref); + printf("rank %d : %f - %f - %f\n", rank, val, ref, eps); + + /*eigen value order: smallest -> biggest*/ + if(eps>1.e-05){ free(d); return 1; } @@ -91,10 +96,9 @@ return 0; } -void zMatVec(double _Complex * x, double _Complex * y) { +void zMatVec(double _Complex* x, double _Complex* y) { int i; - for (i = 0; i < 1000; ++i) - y[i] = x[i] * (i+1.0 + _Complex_I * (i+1.0)); + for (i = 0; i < 1000; ++i) y[i] = x[i] * (i + 1.0 + _Complex_I * (i + 1.0)); }; int zn() { @@ -103,57 +107,66 @@ a_int N = 1000; char which[] = "LM"; a_int nev = 1; - double tol = 0; + double tol = 0.000001; // small tol => more stable checks after EV computation. double _Complex resid[N]; - a_int ncv = 2*nev+1; - double _Complex V[ncv*N]; + a_int ncv = 2 * nev + 1; + double _Complex V[ncv * N]; a_int ldv = N; a_int iparam[11]; a_int ipntr[14]; - double _Complex workd[3*N]; - bool rvec = true; + double _Complex workd[3 * N]; + a_int rvec = 0; char howmny[] = "A"; - double _Complex* d = (double _Complex*) malloc((nev+1)*sizeof(double _Complex)); + double _Complex* d = + (double _Complex*)malloc((nev + 1) * sizeof(double _Complex)); a_int select[ncv]; - double _Complex z[(N+1)*(nev+1)]; - a_int ldz = N+1; - double _Complex sigma=0. + I*0.; + for (int i = 0; i < ncv; i++) select[i] = 1; + double _Complex z[(N + 1) * (nev + 1)]; + a_int ldz = N + 1; + double _Complex sigma = 0. + I * 0.; int k; - for (k=0; k < 3*N; ++k ) - workd[k] = 0. + I * 0.; - double _Complex workl[3*(ncv*ncv) + 6*ncv]; - for (k=0; k < 3*(ncv*ncv) + 6*ncv; ++k ) - workl[k] = 0. + I * 0.; - a_int lworkl = 3*(ncv*ncv) + 6*ncv; + for (k = 0; k < 3 * N; ++k) workd[k] = 0. + I * 0.; + double _Complex workl[3 * (ncv * ncv) + 6 * ncv]; + for (k = 0; k < 3 * (ncv * ncv) + 6 * ncv; ++k) workl[k] = 0. + I * 0.; + a_int lworkl = 3 * (ncv * ncv) + 6 * ncv; double _Complex rwork[ncv]; - double _Complex workev[2*ncv]; + double _Complex workev[2 * ncv]; a_int info = 0; - int rank; MPI_Comm_rank(MPI_COMM_WORLD, &rank); + int rank; + MPI_Comm_rank(MPI_COMM_WORLD, &rank); iparam[0] = 1; - iparam[2] = 10*N; + iparam[2] = 10 * N; iparam[3] = 1; - iparam[4] = 0; // number of ev found by arpack. + iparam[4] = 0; // number of ev found by arpack. iparam[6] = 1; MPI_Fint MCW = MPI_Comm_c2f(MPI_COMM_WORLD); - while(ido != 99) { + while (ido != 99) { /* call arpack like you would have, but, use znaupd_c instead of znaupd_ */ - pznaupd_c(MCW, &ido, bmat, N, which, nev, tol, resid, ncv, V, ldv, iparam, ipntr, - workd, workl, lworkl, rwork, &info); + pznaupd_c(MCW, &ido, bmat, N, which, nev, tol, resid, ncv, V, ldv, iparam, + ipntr, workd, workl, lworkl, rwork, &info); - zMatVec(&(workd[ipntr[0]-1]), &(workd[ipntr[1]-1])); + zMatVec(&(workd[ipntr[0] - 1]), &(workd[ipntr[1] - 1])); } - if (iparam[4] != nev) return 1; // check number of ev found by arpack. + if (iparam[4] != nev) {printf("Error: iparam[4] %d, nev %d\n", iparam[4], nev); return 1;} // check number of ev found by arpack. /* call arpack like you would have, but, use zneupd_c instead of zneupd_ */ - pzneupd_c(MCW, rvec, howmny, select, d, z, ldz, sigma, workev, - bmat, N, which, nev, tol, resid, ncv, V, ldv, iparam, ipntr, - workd, workl, lworkl, rwork, &info); + pzneupd_c(MCW, rvec, howmny, select, d, z, ldz, sigma, workev, bmat, N, which, + nev, tol, resid, ncv, V, ldv, iparam, ipntr, workd, workl, lworkl, + rwork, &info); int i; for (i = 0; i < nev; ++i) { - printf("rank %d - %f %f\n", rank, creal(d[i]), cimag(d[i])); - if(fabs(creal(d[i]) - (double)(1000-i))>1e-6 || fabs(cimag(d[i]) - (double)(1000-i))>1e-6){ + double rval = creal(d[i]); + double rref = (N-(nev-1)+i); + double reps = fabs(rval - rref); + double ival = cimag(d[i]); + double iref = (N-(nev-1)+i); + double ieps = fabs(ival - iref); + printf("rank %d : %f %f - %f %f - %f %f\n", rank, rval, ival, rref, iref, reps, ieps); + + /*eigen value order: smallest -> biggest*/ + if(reps>1.e-05 || ieps>1.e-05){ free(d); return 1; } @@ -166,30 +179,34 @@ MPI_Init(NULL, NULL); sstats_c(); - int rc = ds(); // parpack without debug. + int rc = ds(); // parpack without debug. fflush(stdout); MPI_Barrier(MPI_COMM_WORLD); if (rc != 0) return rc; - int nopx_c, nbx_c, nrorth_c, nitref_c, nrstrt_c; + a_int nopx_c, nbx_c, nrorth_c, nitref_c, nrstrt_c; float tsaupd_c, tsaup2_c, tsaitr_c, tseigt_c, tsgets_c, tsapps_c, tsconv_c; float tnaupd_c, tnaup2_c, tnaitr_c, tneigt_c, tngets_c, tnapps_c, tnconv_c; float tcaupd_c, tcaup2_c, tcaitr_c, tceigt_c, tcgets_c, tcapps_c, tcconv_c; float tmvopx_c, tmvbx_c, tgetv0_c, titref_c, trvec_c; - stat_c( &nopx_c, &nbx_c, &nrorth_c, &nitref_c, &nrstrt_c, - &tsaupd_c, &tsaup2_c, &tsaitr_c, &tseigt_c, &tsgets_c, &tsapps_c, &tsconv_c, - &tnaupd_c, &tnaup2_c, &tnaitr_c, &tneigt_c, &tngets_c, &tnapps_c, &tnconv_c, - &tcaupd_c, &tcaup2_c, &tcaitr_c, &tceigt_c, &tcgets_c, &tcapps_c, &tcconv_c, - &tmvopx_c, &tmvbx_c, &tgetv0_c, &titref_c, &trvec_c); - printf("Timers : nopx %d, tmvopx %f - nbx %d, tmvbx %f\n", nopx_c, tmvopx_c, nbx_c, tmvbx_c); + stat_c(&nopx_c, &nbx_c, &nrorth_c, &nitref_c, &nrstrt_c, &tsaupd_c, &tsaup2_c, + &tsaitr_c, &tseigt_c, &tsgets_c, &tsapps_c, &tsconv_c, &tnaupd_c, + &tnaup2_c, &tnaitr_c, &tneigt_c, &tngets_c, &tnapps_c, &tnconv_c, + &tcaupd_c, &tcaup2_c, &tcaitr_c, &tceigt_c, &tcgets_c, &tcapps_c, + &tcconv_c, &tmvopx_c, &tmvbx_c, &tgetv0_c, &titref_c, &trvec_c); + printf("Timers : nopx %d, tmvopx %f - nbx %d, tmvbx %f\n", nopx_c, tmvopx_c, + nbx_c, tmvbx_c); - int rank = 0; MPI_Comm_rank(MPI_COMM_WORLD, &rank); + int rank = 0; + MPI_Comm_rank(MPI_COMM_WORLD, &rank); if (rank == 0) printf("------\n"); + // clang-format off debug_c(6, -6, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1); // set debug flags. - rc = zn(); // parpack with debug. + // clang-format on + rc = zn(); // parpack with debug. fflush(stdout); MPI_Barrier(MPI_COMM_WORLD); if (rc != 0) return rc; diff -Nru arpack-3.7.0/PARPACK/TESTS/MPI/icb_parpack_cpp.cpp arpack-3.8.0/PARPACK/TESTS/MPI/icb_parpack_cpp.cpp --- arpack-3.7.0/PARPACK/TESTS/MPI/icb_parpack_cpp.cpp 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/PARPACK/TESTS/MPI/icb_parpack_cpp.cpp 2020-12-07 10:40:45.000000000 +0000 @@ -11,15 +11,14 @@ * with entries 1000, 999, ... , 2, 1 on the diagonal. */ -#include "parpack.hpp" - #include #include #include #include #include "debug_c.hpp" // debug parpack. -#include "stat_c.hpp" // arpack statistics. +#include "parpack.hpp" +#include "stat_c.hpp" // arpack statistics. void diagonal_matrix_vector_product(float const* const x, float* const y) { for (int i = 0; i < 1000; ++i) { @@ -35,8 +34,8 @@ a_int lworkl = 3 * (ncv * ncv) + 6 * ncv; a_int ldv = N; - bool rvec = true; - float tol = 0.0f; + a_int rvec = 1; + float tol = 0.000001; // small tol => more stable checks after EV computation. float sigma = 0.0f; std::array ipntr; @@ -48,6 +47,7 @@ std::vector z((N + 1) * (nev + 1)); std::vector resid(N); std::vector select(ncv); + for (int i = 0; i < ncv; i++) select[i] = 1; a_int info = 0; @@ -75,7 +75,10 @@ &(workd[ipntr[1] - 1])); } // check number of ev found by arpack. - if (iparam[4] != nev || info != 0) { + if (iparam[4] < nev /*arpack may succeed to compute more EV than expected*/ || + info != 0) { + std::cout << "ERROR: iparam[4] " << iparam[4] << ", nev " << nev + << ", info " << info << std::endl; throw std::domain_error("Error inside ARPACK routines"); } @@ -86,8 +89,13 @@ workl.data(), lworkl, info); for (int i = 0; i < nev; ++i) { - std::cout << "rank " << rank << " - " << d[i] << std::endl; - if (std::abs(d[i] - static_cast(1000 - (nev - 1) + i)) > 1e-1) { + float val = d[i]; + float ref = (N - (nev - 1) + i); + float eps = std::fabs(val - ref); + std::cout << "rank " << rank << " : " << val << " - " << ref << " - " << eps << std::endl; + + /*eigen value order: smallest -> biggest*/ + if (eps > 1.) { throw std::domain_error("Correct eigenvalues not computed"); } } @@ -107,8 +115,8 @@ a_int ldv = N; a_int ldz = N + 1; - float tol = 0.0f; - bool rvec = true; + float tol = 0.000001; // small tol => more stable checks after EV computation. + a_int rvec = 0; std::complex sigma(0.0f, 0.0f); std::vector> resid(N); @@ -117,6 +125,7 @@ std::vector> d(nev + 1); std::vector> z((N + 1) * (nev + 1)); std::vector select(ncv); + for (int i = 0; i < ncv; i++) select[i] = 1; a_int lworkl = 3 * (ncv * ncv) + 6 * ncv; std::vector> workl(lworkl); @@ -153,7 +162,10 @@ } // check number of ev found by arpack - if (iparam[4] != nev || info != 0) { + if (iparam[4] < nev /*arpack may succeed to compute more EV than expected*/ || + info != 0) { + std::cout << "ERROR: iparam[4] " << iparam[4] << ", nev " << nev + << ", info " << info << std::endl; throw std::domain_error("Error inside ARPACK routines"); } @@ -165,10 +177,16 @@ info); for (int i = 0; i < nev; ++i) { - std::cout << "rank " << rank << " - " << std::real(d[i]) << " " - << std::imag(d[i]) << '\n'; - if (std::abs(std::real(d[i]) - static_cast(1000 - i)) > 1e-1 || - std::abs(std::imag(d[i]) - static_cast(1000 - i)) > 1e-1) { + float rval = std::real(d[i]); + float rref = (N-(nev-1)+i); + float reps = std::fabs(rval - rref); + float ival = std::imag(d[i]); + float iref = (N-(nev-1)+i); + float ieps = std::fabs(ival - iref); + std::cout << "rank " << rank << " : " << rval << " " << ival << " - " << rref << " " << iref << " - " << reps << " " << ieps << std::endl; + + /*eigen value order: smallest -> biggest*/ + if (reps > 1. || ieps > 1.) { throw std::domain_error("Correct eigenvalues not computed"); } } @@ -189,7 +207,7 @@ MPI_Barrier(MPI_COMM_WORLD); - int nopx_c, nbx_c, nrorth_c, nitref_c, nrstrt_c; + a_int nopx_c, nbx_c, nrorth_c, nitref_c, nrstrt_c; float tsaupd_c, tsaup2_c, tsaitr_c, tseigt_c, tsgets_c, tsapps_c, tsconv_c; float tnaupd_c, tnaup2_c, tnaitr_c, tneigt_c, tngets_c, tnapps_c, tnconv_c; float tcaupd_c, tcaup2_c, tcaitr_c, tceigt_c, tcgets_c, tcapps_c, tcconv_c; diff -Nru arpack-3.7.0/PARPACK/TESTS/MPI/Makefile.am arpack-3.8.0/PARPACK/TESTS/MPI/Makefile.am --- arpack-3.7.0/PARPACK/TESTS/MPI/Makefile.am 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/PARPACK/TESTS/MPI/Makefile.am 2020-12-07 10:40:45.000000000 +0000 @@ -19,11 +19,11 @@ if ICB icb_parpack_c_SOURCES = icb_parpack_c.c -icb_parpack_c_LDADD = $(LDADD) $(MPI_C_LIBS) +icb_parpack_c_LDADD = $(top_builddir)/PARPACK/SRC/MPI/libparpack$(LIBSUFFIX).la $(MPI_C_LIBS) icb_parpack_c_CPPFLAGS = $(AM_CPPFLAGS) -I$(top_builddir) -I$(top_srcdir)/ICB icb_parpack_cpp_SOURCES = icb_parpack_cpp.cpp -icb_parpack_cpp_LDADD = $(LDADD) $(MPI_CXX_LIBS) +icb_parpack_cpp_LDADD = $(top_builddir)/PARPACK/SRC/MPI/libparpack$(LIBSUFFIX).la $(MPI_CXX_LIBS) icb_parpack_cpp_CPPFLAGS = $(AM_CPPFLAGS) -I$(top_builddir) -I$(top_srcdir)/ICB endif diff -Nru arpack-3.7.0/README.md arpack-3.8.0/README.md --- arpack-3.7.0/README.md 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/README.md 2020-12-07 10:40:45.000000000 +0000 @@ -18,20 +18,29 @@ * arpackmm: utility to test arpack with matrix market files. Note: to run this utility, you need the eigen library (to handle RCI). * ILP64 support: + * reminder: you can NOT mix ILP64 with LP64. If you compile arpack-ng with ILP64 + (resp. LP64) support, you MUST insure your BLAS/LAPACK is compliant with ILP64 + (resp. LP64). * users: set INTERFACE64 at configure time. - * developers: + * F77/F90 developers: + * all files which needs ILP64 support must include "arpackicb.h". + * when coding, use i_int (defined in arpackicb.h) instead of c_int. + i_int stands for "iso_c_binding int": it's #defined to c_int or c_int64_t + according to the architecture. + * C/C++ developers: * all files which needs ILP64 support must include "arpackdef.h". * when coding, use a_int (defined in arpackdef.h) instead of int. a_int stands for "architecture int": it's #defined to int or int64_t according to the architecture. * example: to test arpack with sequential ILP64 MKL assuming you use gnu compilers ```$ ./bootstrap - $ export FFLAGS='-I/usr/include/mkl' - $ export FCFLAGS='-I/usr/include/mkl' - $ export LIBS='-Wl,--no-as-needed -lmkl_sequential -lmkl_core -lpthread -lm -ldl' + $ export FFLAGS='-DMKL_ILP64 -I/usr/include/mkl' + $ export FCFLAGS='-DMKL_ILP64 -I/usr/include/mkl' + $ export LIBS='-Wl,--no-as-needed -L/usr/lib/x86_64-linux-gnu -lmkl_sequential -lmkl_core -lpthread -lm -ldl' $ export INTERFACE64=1 $ ./configure --with-blas=mkl_gf_ilp64 --with-lapack=mkl_gf_ilp64 $ make all check``` +* pyarpack: python support based on Boost.Python.Numpy exposing C++ API. This project started as a joint project between Debian, Octave and Scilab in order to provide a common and maintained version of arpack. @@ -108,6 +117,24 @@ $ make install builds everything including examples and parallel support (with MPI). +To use arpack from CMake, use ARPACK::ARPACK target: + + find_package(arpack-ng) + add_executable(main main.f) + target_include_directories(main PUBLIC ARPACK::ARPACK) + target_link_libraries(main ARPACK::ARPACK) + +To use parpack from CMake, use PARPACK::PARPACK target: + + find_package(arpack-ng) + add_executable(main main.f) + target_include_directories(main PUBLIC PARPACK::PARPACK) + target_link_libraries(main PARPACK::PARPACK) + +On mac OS, with GNU compilers, you may need to customize options: + + $ LIBS="-framework Accelerate" FFLAGS="-ff2c -fno-second-underscore" FCFLAGS="-ff2c -fno-second-underscore" ./configure + To build with code coverage: $ mkdir build diff -Nru arpack-3.7.0/scripts/travis_fedora.sh arpack-3.8.0/scripts/travis_fedora.sh --- arpack-3.7.0/scripts/travis_fedora.sh 1970-01-01 00:00:00.000000000 +0000 +++ arpack-3.8.0/scripts/travis_fedora.sh 2020-12-07 10:40:45.000000000 +0000 @@ -0,0 +1,54 @@ +#!/bin/sh +## -e : Make sure all errors cause the script to fail +## -x be verbose; write what we are doing, as we do it +set -ex +## Should we init a container? +if [ ".$1" = .setup ] +then + # fedora + # note: when you PR, docker-cp provides, in the container, the branch associated with the PR (not master where there's nothing new) + # 1. docker create --name mobydick IMAGE CMD <=> create a container (= instance of image) but container is NOT yet started + # 2. docker cp -a ${TRAVIS_BUILD_DIR} mobydick:/tmp <=> copy git repository (CI worker, checkout-ed on PR branch) into the container + # note: docker-cp works only if copy from/to containers (not images) + # 3. docker start -a mobydick <=> start to run the container (initialized with docker-cp) + test . != ".$2" && mpi="$2" || mpi=openmpi + test . != ".$3" && version="$3" || version=latest + time sudo docker pull registry.fedoraproject.org/fedora:$version || + sudo docker pull fedora:$version + time sudo docker create --name mobydick fedora:$version \ + /tmp/arpack-ng/scripts/travis_fedora.sh $mpi + time sudo docker cp -a ${TRAVIS_BUILD_DIR} mobydick:/tmp + time sudo docker start -a mobydick ; e=$? + exit $e +fi + +test . != ".$1" && mpi="$1" || mpi=openmpi + +## If we are called as root, setup everything +if [ $UID -eq 0 ] +then + cat /etc/os-release + # Ignore weak depencies + echo "install_weak_deps=False" >> /etc/dnf/dnf.conf + time dnf -y upgrade + time dnf -y install environment-modules git \ + gfortran openblas-devel cmake ${mpi}-devel make gcc-c++ + useradd test + chown -R test /tmp + sudo -u test $0 $mpi +## If we are called as normal user, run test +else + . /etc/profile.d/modules.sh + module load mpi + export OMPI_MCA_rmaps_base_oversubscribe=yes + cd /tmp + cd arpack-ng + git status + git log -2 + mkdir -p build && cd build + time cmake -DEXAMPLES=ON -DMPI=ON -DICB=ON .. + export VERBOSE=1 + time make all + time make test + tail -n 300 ./Testing/Temporary/LastTest.log +fi diff -Nru arpack-3.7.0/scripts/travis_ubuntu.sh arpack-3.8.0/scripts/travis_ubuntu.sh --- arpack-3.7.0/scripts/travis_ubuntu.sh 1970-01-01 00:00:00.000000000 +0000 +++ arpack-3.8.0/scripts/travis_ubuntu.sh 2020-12-07 10:40:45.000000000 +0000 @@ -0,0 +1,35 @@ +#!/bin/sh +## -e : Make sure all errors cause the script to fail +## -x be verbose; write what we are doing, as we do it +set -ex + +sudo docker pull "$1$2" \ +&& \ +sudo docker create --name mobydick "$1$2" /bin/bash -c \ +"apt-get update && \ + ln -snf /usr/share/zoneinfo/Europe/Paris /etc/localtime && echo 'Europe/Paris' > /etc/timezone && \ + apt-get -y install build-essential && \ + apt-get -y install dialog apt-utils && \ + apt-get -y install git gfortran gcc g++ openmpi-bin libopenmpi-dev automake autoconf libtool pkg-config cmake && \ + apt-get -y install libblas-dev liblapack-dev && \ + cd /tmp && \ + cd arpack-ng && \ + git status && \ + git log -2 && \ + sed -e 's/LOG_FLAGS = /LOG_FLAGS = --allow-run-as-root --oversubscribe /' -i PARPACK/EXAMPLES/MPI/Makefile.am && \ + sed -e 's/LOG_FLAGS = /LOG_FLAGS = --allow-run-as-root --oversubscribe /' -i PARPACK/TESTS/MPI/Makefile.am && \ + ./bootstrap && \ + ./configure --enable-icb --enable-mpi --disable-dependency-tracking && \ + export VERBOSE=1 && \ + make all && \ + make check; find . -name test-suite.log | xargs tail -n 50 && \ + make distcheck && \ + sed -e 's/mpirun /mpirun --allow-run-as-root --oversubscribe /' -i CMakeLists.txt && \ + mkdir -p build && cd build && \ + cmake -DEXAMPLES=ON -DMPI=ON -DICB=ON .. && \ + make all && \ + make test; tail -n 50 ./Testing/Temporary/LastTest.log" \ +&& \ +sudo docker cp -a ${TRAVIS_BUILD_DIR} mobydick:/tmp \ +&& \ +sudo docker start -a mobydick diff -Nru arpack-3.7.0/SRC/arpack.pc.in arpack-3.8.0/SRC/arpack.pc.in --- arpack-3.7.0/SRC/arpack.pc.in 1970-01-01 00:00:00.000000000 +0000 +++ arpack-3.8.0/SRC/arpack.pc.in 2020-12-07 10:40:45.000000000 +0000 @@ -0,0 +1,12 @@ +prefix=@prefix@ +exec_prefix=@exec_prefix@ +libdir=@libdir@ +includedir=@includedir@ + +Name: @PACKAGE_NAME@ +Description: Collection of Fortran77 subroutines designed to solve large scale eigenvalue problems +Version: @PACKAGE_VERSION@ +URL: @PACKAGE_URL@ +Libs: -L${libdir} -larpack@LIBSUFFIX@ +Libs.private: @ARPACK_PC_LIBS_PRIVATE@ +Cflags: -I${includedir}/arpack diff -Nru arpack-3.7.0/SRC/cgetv0.f arpack-3.8.0/SRC/cgetv0.f --- arpack-3.7.0/SRC/cgetv0.f 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/SRC/cgetv0.f 2020-12-07 10:40:45.000000000 +0000 @@ -361,9 +361,9 @@ c %--------------------------------------% c if (msglvl .gt. 2) then - call svout (logfil, 1, rnorm0, ndigit, + call svout (logfil, 1, [rnorm0], ndigit, & '_getv0: re-orthonalization ; rnorm0 is') - call svout (logfil, 1, rnorm, ndigit, + call svout (logfil, 1, [rnorm], ndigit, & '_getv0: re-orthonalization ; rnorm is') end if c @@ -394,7 +394,7 @@ 50 continue c if (msglvl .gt. 0) then - call svout (logfil, 1, rnorm, ndigit, + call svout (logfil, 1, [rnorm], ndigit, & '_getv0: B-norm of initial / restarted starting vector') end if if (msglvl .gt. 2) then diff -Nru arpack-3.7.0/SRC/cnaitr.f arpack-3.8.0/SRC/cnaitr.f --- arpack-3.7.0/SRC/cnaitr.f 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/SRC/cnaitr.f 2020-12-07 10:40:45.000000000 +0000 @@ -378,9 +378,9 @@ 1000 continue c if (msglvl .gt. 1) then - call ivout (logfil, 1, j, ndigit, + call ivout (logfil, 1, [j], ndigit, & '_naitr: generating Arnoldi vector number') - call svout (logfil, 1, rnorm, ndigit, + call svout (logfil, 1, [rnorm], ndigit, & '_naitr: B-norm of the current residual is') end if c @@ -400,7 +400,7 @@ c %---------------------------------------------------% c if (msglvl .gt. 0) then - call ivout (logfil, 1, j, ndigit, + call ivout (logfil, 1, [j], ndigit, & '_naitr: ****** RESTART AT STEP ******') end if c @@ -729,7 +729,7 @@ end if c if (msglvl .gt. 0 .and. iter .gt. 0 ) then - call ivout (logfil, 1, j, ndigit, + call ivout (logfil, 1, [j], ndigit, & '_naitr: Iterative refinement for Arnoldi residual') if (msglvl .gt. 2) then rtemp(1) = rnorm diff -Nru arpack-3.7.0/SRC/cnapps.f arpack-3.8.0/SRC/cnapps.f --- arpack-3.7.0/SRC/cnapps.f 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/SRC/cnapps.f 2020-12-07 10:40:45.000000000 +0000 @@ -268,9 +268,9 @@ sigma = shift(jj) c if (msglvl .gt. 2 ) then - call ivout (logfil, 1, jj, ndigit, + call ivout (logfil, 1, [jj], ndigit, & '_napps: shift number.') - call cvout (logfil, 1, sigma, ndigit, + call cvout (logfil, 1, [sigma], ndigit, & '_napps: Value of the shift ') end if c @@ -291,9 +291,9 @@ if ( abs(real(h(i+1,i))) & .le. max(ulp*tst1, smlnum) ) then if (msglvl .gt. 0) then - call ivout (logfil, 1, i, ndigit, + call ivout (logfil, 1, [i], ndigit, & '_napps: matrix splitting at row/column no.') - call ivout (logfil, 1, jj, ndigit, + call ivout (logfil, 1, [jj], ndigit, & '_napps: matrix splitting with shift number.') call cvout (logfil, 1, h(i+1,i), ndigit, & '_napps: off diagonal element.') @@ -307,9 +307,9 @@ 40 continue c if (msglvl .gt. 2) then - call ivout (logfil, 1, istart, ndigit, + call ivout (logfil, 1, [istart], ndigit, & '_napps: Start of current block ') - call ivout (logfil, 1, iend, ndigit, + call ivout (logfil, 1, [iend], ndigit, & '_napps: End of current block ') end if c @@ -485,7 +485,7 @@ & '_napps: sigmak = (e_{kev+p}^T*Q)*e_{kev}') call cvout (logfil, 1, h(kev+1,kev), ndigit, & '_napps: betak = e_{kev+1}^T*H*e_{kev}') - call ivout (logfil, 1, kev, ndigit, + call ivout (logfil, 1, [kev], ndigit, & '_napps: Order of the final Hessenberg matrix ') if (msglvl .gt. 2) then call cmout (logfil, kev, kev, h, ldh, ndigit, diff -Nru arpack-3.7.0/SRC/cnaup2.f arpack-3.8.0/SRC/cnaup2.f --- arpack-3.7.0/SRC/cnaup2.f 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/SRC/cnaup2.f 2020-12-07 10:40:45.000000000 +0000 @@ -389,7 +389,7 @@ iter = iter + 1 c if (msglvl .gt. 0) then - call ivout (logfil, 1, iter, ndigit, + call ivout (logfil, 1, [iter], ndigit, & '_naup2: **** Start of major iteration number ****') end if c @@ -402,9 +402,9 @@ np = kplusp - nev c if (msglvl .gt. 1) then - call ivout (logfil, 1, nev, ndigit, + call ivout (logfil, 1, [nev], ndigit, & '_naup2: The length of the current Arnoldi factorization') - call ivout (logfil, 1, np, ndigit, + call ivout (logfil, 1, [np], ndigit, & '_naup2: Extend the Arnoldi factorization by') end if c @@ -430,7 +430,7 @@ update = .false. c if (msglvl .gt. 1) then - call svout (logfil, 1, rnorm, ndigit, + call svout (logfil, 1, [rnorm], ndigit, & '_naup2: Corresponding B-norm of the residual') end if c @@ -658,7 +658,7 @@ end if c if (msglvl .gt. 0) then - call ivout (logfil, 1, nconv, ndigit, + call ivout (logfil, 1, [nconv], ndigit, & '_naup2: no. of "converged" Ritz values at this iter.') if (msglvl .gt. 1) then kp(1) = nev @@ -698,7 +698,7 @@ end if c if (msglvl .gt. 2) then - call ivout (logfil, 1, np, ndigit, + call ivout (logfil, 1, [np], ndigit, & '_naup2: The number of shifts to apply ') call cvout (logfil, np, ritz, ndigit, & '_naup2: values of the shifts') @@ -762,7 +762,7 @@ cnorm = .false. c if (msglvl .gt. 2) then - call svout (logfil, 1, rnorm, ndigit, + call svout (logfil, 1, [rnorm], ndigit, & '_naup2: B-norm of residual for compressed factorization') call cmout (logfil, nev, nev, h, ldh, ndigit, & '_naup2: Compressed upper Hessenberg matrix H') diff -Nru arpack-3.7.0/SRC/cnaupd.f arpack-3.8.0/SRC/cnaupd.f --- arpack-3.7.0/SRC/cnaupd.f 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/SRC/cnaupd.f 2020-12-07 10:40:45.000000000 +0000 @@ -601,9 +601,9 @@ if (info .eq. 2) info = 3 c if (msglvl .gt. 0) then - call ivout (logfil, 1, mxiter, ndigit, + call ivout (logfil, 1, [mxiter], ndigit, & '_naupd: Number of update iterations taken') - call ivout (logfil, 1, np, ndigit, + call ivout (logfil, 1, [np], ndigit, & '_naupd: Number of wanted "converged" Ritz values') call cvout (logfil, np, workl(ritz), ndigit, & '_naupd: The final Ritz values') diff -Nru arpack-3.7.0/SRC/cneupd.f arpack-3.8.0/SRC/cneupd.f --- arpack-3.7.0/SRC/cneupd.f 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/SRC/cneupd.f 2020-12-07 10:40:45.000000000 +0000 @@ -536,9 +536,9 @@ c %-----------------------------------------------------------% c if (msglvl .gt. 2) then - call ivout(logfil, 1, numcnv, ndigit, + call ivout(logfil, 1, [numcnv], ndigit, & '_neupd: Number of specified eigenvalues') - call ivout(logfil, 1, nconv, ndigit, + call ivout(logfil, 1, [nconv], ndigit, & '_neupd: Number of "converged" eigenvalues') end if c diff -Nru arpack-3.7.0/SRC/cngets.f arpack-3.8.0/SRC/cngets.f --- arpack-3.7.0/SRC/cngets.f 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/SRC/cngets.f 2020-12-07 10:40:45.000000000 +0000 @@ -161,8 +161,8 @@ tcgets = tcgets + (t1 - t0) c if (msglvl .gt. 0) then - call ivout (logfil, 1, kev, ndigit, '_ngets: KEV is') - call ivout (logfil, 1, np, ndigit, '_ngets: NP is') + call ivout (logfil, 1, [kev], ndigit, '_ngets: KEV is') + call ivout (logfil, 1, [np], ndigit, '_ngets: NP is') call cvout (logfil, kev+np, ritz, ndigit, & '_ngets: Eigenvalues of current H matrix ') call cvout (logfil, kev+np, bounds, ndigit, diff -Nru arpack-3.7.0/SRC/dgetv0.f arpack-3.8.0/SRC/dgetv0.f --- arpack-3.7.0/SRC/dgetv0.f 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/SRC/dgetv0.f 2020-12-07 10:40:45.000000000 +0000 @@ -366,9 +366,9 @@ c %--------------------------------------% c if (msglvl .gt. 2) then - call dvout (logfil, 1, rnorm0, ndigit, + call dvout (logfil, 1, [rnorm0], ndigit, & '_getv0: re-orthonalization ; rnorm0 is') - call dvout (logfil, 1, rnorm, ndigit, + call dvout (logfil, 1, [rnorm], ndigit, & '_getv0: re-orthonalization ; rnorm is') end if c @@ -399,7 +399,7 @@ 50 continue c if (msglvl .gt. 0) then - call dvout (logfil, 1, rnorm, ndigit, + call dvout (logfil, 1, [rnorm], ndigit, & '_getv0: B-norm of initial / restarted starting vector') end if if (msglvl .gt. 3) then diff -Nru arpack-3.7.0/SRC/dnaitr.f arpack-3.8.0/SRC/dnaitr.f --- arpack-3.7.0/SRC/dnaitr.f 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/SRC/dnaitr.f 2020-12-07 10:40:45.000000000 +0000 @@ -371,9 +371,9 @@ 1000 continue c if (msglvl .gt. 1) then - call ivout (logfil, 1, j, ndigit, + call ivout (logfil, 1, [j], ndigit, & '_naitr: generating Arnoldi vector number') - call dvout (logfil, 1, rnorm, ndigit, + call dvout (logfil, 1, [rnorm], ndigit, & '_naitr: B-norm of the current residual is') end if c @@ -393,7 +393,7 @@ c %---------------------------------------------------% c if (msglvl .gt. 0) then - call ivout (logfil, 1, j, ndigit, + call ivout (logfil, 1, [j], ndigit, & '_naitr: ****** RESTART AT STEP ******') end if c @@ -721,7 +721,7 @@ end if c if (msglvl .gt. 0 .and. iter .gt. 0) then - call ivout (logfil, 1, j, ndigit, + call ivout (logfil, 1, [j], ndigit, & '_naitr: Iterative refinement for Arnoldi residual') if (msglvl .gt. 2) then xtemp(1) = rnorm diff -Nru arpack-3.7.0/SRC/dnapps.f arpack-3.8.0/SRC/dnapps.f --- arpack-3.7.0/SRC/dnapps.f 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/SRC/dnapps.f 2020-12-07 10:40:45.000000000 +0000 @@ -266,11 +266,11 @@ sigmai = shifti(jj) c if (msglvl .gt. 2 ) then - call ivout (logfil, 1, jj, ndigit, + call ivout (logfil, 1, [jj], ndigit, & '_napps: shift number.') - call dvout (logfil, 1, sigmar, ndigit, + call dvout (logfil, 1, [sigmar], ndigit, & '_napps: The real part of the shift ') - call dvout (logfil, 1, sigmai, ndigit, + call dvout (logfil, 1, [sigmai], ndigit, & '_napps: The imaginary part of the shift ') end if c @@ -335,9 +335,9 @@ & tst1 = dlanhs( '1', kplusp-jj+1, h, ldh, workl ) if( abs( h( i+1,i ) ).le.max( ulp*tst1, smlnum ) ) then if (msglvl .gt. 0) then - call ivout (logfil, 1, i, ndigit, + call ivout (logfil, 1, [i], ndigit, & '_napps: matrix splitting at row/column no.') - call ivout (logfil, 1, jj, ndigit, + call ivout (logfil, 1, [jj], ndigit, & '_napps: matrix splitting with shift number.') call dvout (logfil, 1, h(i+1,i), ndigit, & '_napps: off diagonal element.') @@ -351,9 +351,9 @@ 40 continue c if (msglvl .gt. 2) then - call ivout (logfil, 1, istart, ndigit, + call ivout (logfil, 1, [istart], ndigit, & '_napps: Start of current block ') - call ivout (logfil, 1, iend, ndigit, + call ivout (logfil, 1, [iend], ndigit, & '_napps: End of current block ') end if c @@ -627,7 +627,7 @@ & '_napps: sigmak = (e_{kev+p}^T*Q)*e_{kev}') call dvout (logfil, 1, h(kev+1,kev), ndigit, & '_napps: betak = e_{kev+1}^T*H*e_{kev}') - call ivout (logfil, 1, kev, ndigit, + call ivout (logfil, 1, [kev], ndigit, & '_napps: Order of the final Hessenberg matrix ') if (msglvl .gt. 2) then call dmout (logfil, kev, kev, h, ldh, ndigit, diff -Nru arpack-3.7.0/SRC/dnaup2.f arpack-3.8.0/SRC/dnaup2.f --- arpack-3.7.0/SRC/dnaup2.f 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/SRC/dnaup2.f 2020-12-07 10:40:45.000000000 +0000 @@ -388,7 +388,7 @@ iter = iter + 1 c if (msglvl .gt. 0) then - call ivout (logfil, 1, iter, ndigit, + call ivout (logfil, 1, [iter], ndigit, & '_naup2: **** Start of major iteration number ****') end if c @@ -401,9 +401,9 @@ np = kplusp - nev c if (msglvl .gt. 1) then - call ivout (logfil, 1, nev, ndigit, + call ivout (logfil, 1, [nev], ndigit, & '_naup2: The length of the current Arnoldi factorization') - call ivout (logfil, 1, np, ndigit, + call ivout (logfil, 1, [np], ndigit, & '_naup2: Extend the Arnoldi factorization by') end if c @@ -435,7 +435,7 @@ update = .false. c if (msglvl .gt. 1) then - call dvout (logfil, 1, rnorm, ndigit, + call dvout (logfil, 1, [rnorm], ndigit, & '_naup2: Corresponding B-norm of the residual') end if c @@ -689,7 +689,7 @@ end if c if (msglvl .gt. 0) then - call ivout (logfil, 1, nconv, ndigit, + call ivout (logfil, 1, [nconv], ndigit, & '_naup2: no. of "converged" Ritz values at this iter.') if (msglvl .gt. 1) then kp(1) = nev @@ -741,7 +741,7 @@ end if c if (msglvl .gt. 2) then - call ivout (logfil, 1, np, ndigit, + call ivout (logfil, 1, [np], ndigit, & '_naup2: The number of shifts to apply ') call dvout (logfil, np, ritzr, ndigit, & '_naup2: Real part of the shifts') @@ -807,7 +807,7 @@ cnorm = .false. c if (msglvl .gt. 2) then - call dvout (logfil, 1, rnorm, ndigit, + call dvout (logfil, 1, [rnorm], ndigit, & '_naup2: B-norm of residual for compressed factorization') call dmout (logfil, nev, nev, h, ldh, ndigit, & '_naup2: Compressed upper Hessenberg matrix H') diff -Nru arpack-3.7.0/SRC/dnaupd.f arpack-3.8.0/SRC/dnaupd.f --- arpack-3.7.0/SRC/dnaupd.f 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/SRC/dnaupd.f 2020-12-07 10:40:45.000000000 +0000 @@ -628,9 +628,9 @@ if (info .eq. 2) info = 3 c if (msglvl .gt. 0) then - call ivout (logfil, 1, mxiter, ndigit, + call ivout (logfil, 1, [mxiter], ndigit, & '_naupd: Number of update iterations taken') - call ivout (logfil, 1, np, ndigit, + call ivout (logfil, 1, [np], ndigit, & '_naupd: Number of wanted "converged" Ritz values') call dvout (logfil, np, workl(ritzr), ndigit, & '_naupd: Real part of the final Ritz values') diff -Nru arpack-3.7.0/SRC/dneupd.f arpack-3.8.0/SRC/dneupd.f --- arpack-3.7.0/SRC/dneupd.f 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/SRC/dneupd.f 2020-12-07 10:40:45.000000000 +0000 @@ -601,9 +601,9 @@ c %-----------------------------------------------------------% c if (msglvl .gt. 2) then - call ivout(logfil, 1, numcnv, ndigit, + call ivout(logfil, 1, [numcnv], ndigit, & '_neupd: Number of specified eigenvalues') - call ivout(logfil, 1, nconv, ndigit, + call ivout(logfil, 1, [nconv], ndigit, & '_neupd: Number of "converged" eigenvalues') end if c diff -Nru arpack-3.7.0/SRC/dngets.f arpack-3.8.0/SRC/dngets.f --- arpack-3.7.0/SRC/dngets.f 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/SRC/dngets.f 2020-12-07 10:40:45.000000000 +0000 @@ -212,8 +212,8 @@ tngets = tngets + (t1 - t0) c if (msglvl .gt. 0) then - call ivout (logfil, 1, kev, ndigit, '_ngets: KEV is') - call ivout (logfil, 1, np, ndigit, '_ngets: NP is') + call ivout (logfil, 1, [kev], ndigit, '_ngets: KEV is') + call ivout (logfil, 1, [np], ndigit, '_ngets: NP is') call dvout (logfil, kev+np, ritzr, ndigit, & '_ngets: Eigenvalues of current H matrix -- real part') call dvout (logfil, kev+np, ritzi, ndigit, diff -Nru arpack-3.7.0/SRC/dsaitr.f arpack-3.8.0/SRC/dsaitr.f --- arpack-3.7.0/SRC/dsaitr.f 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/SRC/dsaitr.f 2020-12-07 10:40:45.000000000 +0000 @@ -364,9 +364,9 @@ 1000 continue c if (msglvl .gt. 2) then - call ivout (logfil, 1, j, ndigit, + call ivout (logfil, 1, [j], ndigit, & '_saitr: generating Arnoldi vector no.') - call dvout (logfil, 1, rnorm, ndigit, + call dvout (logfil, 1, [rnorm], ndigit, & '_saitr: B-norm of the current residual =') end if c @@ -384,7 +384,7 @@ c %---------------------------------------------------% c if (msglvl .gt. 0) then - call ivout (logfil, 1, j, ndigit, + call ivout (logfil, 1, [j], ndigit, & '_saitr: ****** restart at step ******') end if c @@ -735,7 +735,7 @@ end if c if (msglvl .gt. 0 .and. iter .gt. 0) then - call ivout (logfil, 1, j, ndigit, + call ivout (logfil, 1, [j], ndigit, & '_saitr: Iterative refinement for Arnoldi residual') if (msglvl .gt. 2) then xtemp(1) = rnorm diff -Nru arpack-3.7.0/SRC/dsapps.f arpack-3.8.0/SRC/dsapps.f --- arpack-3.7.0/SRC/dsapps.f 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/SRC/dsapps.f 2020-12-07 10:40:45.000000000 +0000 @@ -261,9 +261,9 @@ big = abs(h(i,2)) + abs(h(i+1,2)) if (h(i+1,1) .le. epsmch*big) then if (msglvl .gt. 0) then - call ivout (logfil, 1, i, ndigit, + call ivout (logfil, 1, [i], ndigit, & '_sapps: deflation at row/column no.') - call ivout (logfil, 1, jj, ndigit, + call ivout (logfil, 1, [jj], ndigit, & '_sapps: occurred before shift number.') call dvout (logfil, 1, h(i+1,1), ndigit, & '_sapps: the corresponding off diagonal element') @@ -432,7 +432,7 @@ big = abs(h(i,2)) + abs(h(i+1,2)) if (h(i+1,1) .le. epsmch*big) then if (msglvl .gt. 0) then - call ivout (logfil, 1, i, ndigit, + call ivout (logfil, 1, [i], ndigit, & '_sapps: deflation at row/column no.') call dvout (logfil, 1, h(i+1,1), ndigit, & '_sapps: the corresponding off diagonal element') diff -Nru arpack-3.7.0/SRC/dsaup2.f arpack-3.8.0/SRC/dsaup2.f --- arpack-3.7.0/SRC/dsaup2.f 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/SRC/dsaup2.f 2020-12-07 10:40:45.000000000 +0000 @@ -402,13 +402,13 @@ iter = iter + 1 c if (msglvl .gt. 0) then - call ivout (logfil, 1, iter, ndigit, + call ivout (logfil, 1, [iter], ndigit, & '_saup2: **** Start of major iteration number ****') end if if (msglvl .gt. 1) then - call ivout (logfil, 1, nev, ndigit, + call ivout (logfil, 1, [nev], ndigit, & '_saup2: The length of the current Lanczos factorization') - call ivout (logfil, 1, np, ndigit, + call ivout (logfil, 1, [np], ndigit, & '_saup2: Extend the Lanczos factorization by') end if c @@ -446,7 +446,7 @@ update = .false. c if (msglvl .gt. 1) then - call dvout (logfil, 1, rnorm, ndigit, + call dvout (logfil, 1, [rnorm], ndigit, & '_saup2: Current B-norm of residual for factorization') end if c @@ -695,7 +695,7 @@ end if c if (msglvl .gt. 0) then - call ivout (logfil, 1, nconv, ndigit, + call ivout (logfil, 1, [nconv], ndigit, & '_saup2: no. of "converged" Ritz values at this iter.') if (msglvl .gt. 1) then kp(1) = nev @@ -743,7 +743,7 @@ if (ishift .eq. 0) call dcopy (np, workl, 1, ritz, 1) c if (msglvl .gt. 2) then - call ivout (logfil, 1, np, ndigit, + call ivout (logfil, 1, [np], ndigit, & '_saup2: The number of shifts to apply ') call dvout (logfil, np, workl, ndigit, & '_saup2: shifts selected') @@ -810,7 +810,7 @@ 130 continue c if (msglvl .gt. 2) then - call dvout (logfil, 1, rnorm, ndigit, + call dvout (logfil, 1, [rnorm], ndigit, & '_saup2: B-norm of residual for NEV factorization') call dvout (logfil, nev, h(1,2), ndigit, & '_saup2: main diagonal of compressed H matrix') diff -Nru arpack-3.7.0/SRC/dsaupd.f arpack-3.8.0/SRC/dsaupd.f --- arpack-3.7.0/SRC/dsaupd.f 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/SRC/dsaupd.f 2020-12-07 10:40:45.000000000 +0000 @@ -628,9 +628,9 @@ if (info .eq. 2) info = 3 c if (msglvl .gt. 0) then - call ivout (logfil, 1, mxiter, ndigit, + call ivout (logfil, 1, [mxiter], ndigit, & '_saupd: number of update iterations taken') - call ivout (logfil, 1, np, ndigit, + call ivout (logfil, 1, [np], ndigit, & '_saupd: number of "converged" Ritz values') call dvout (logfil, np, workl(Ritz), ndigit, & '_saupd: final Ritz values') diff -Nru arpack-3.7.0/SRC/dseupd.f arpack-3.8.0/SRC/dseupd.f --- arpack-3.7.0/SRC/dseupd.f 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/SRC/dseupd.f 2020-12-07 10:40:45.000000000 +0000 @@ -513,9 +513,9 @@ c %-----------------------------------------------------------% c if (msglvl .gt. 2) then - call ivout(logfil, 1, numcnv, ndigit, + call ivout(logfil, 1, [numcnv], ndigit, & '_seupd: Number of specified eigenvalues') - call ivout(logfil, 1, nconv, ndigit, + call ivout(logfil, 1, [nconv], ndigit, & '_seupd: Number of "converged" eigenvalues') end if c diff -Nru arpack-3.7.0/SRC/dsgets.f arpack-3.8.0/SRC/dsgets.f --- arpack-3.7.0/SRC/dsgets.f 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/SRC/dsgets.f 2020-12-07 10:40:45.000000000 +0000 @@ -202,8 +202,8 @@ tsgets = tsgets + (t1 - t0) c if (msglvl .gt. 0) then - call ivout (logfil, 1, kev, ndigit, '_sgets: KEV is') - call ivout (logfil, 1, np, ndigit, '_sgets: NP is') + call ivout (logfil, 1, [kev], ndigit, '_sgets: KEV is') + call ivout (logfil, 1, [np], ndigit, '_sgets: NP is') call dvout (logfil, kev+np, ritz, ndigit, & '_sgets: Eigenvalues of current H matrix') call dvout (logfil, kev+np, bounds, ndigit, diff -Nru arpack-3.7.0/SRC/icbacn.F90 arpack-3.8.0/SRC/icbacn.F90 --- arpack-3.7.0/SRC/icbacn.F90 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/SRC/icbacn.F90 2020-12-07 10:40:45.000000000 +0000 @@ -5,25 +5,33 @@ bind(c, name="cnaupd_c") use :: iso_c_binding implicit none -#include "arpackdef.h" - integer(kind=c_int), intent(inout) :: ido - character(kind=c_char), dimension(1), intent(in) :: bmat - integer(kind=c_int), value, intent(in) :: n +#include "arpackicb.h" + integer(kind=i_int), intent(inout) :: ido + character(kind=c_char), intent(in) :: bmat + integer(kind=i_int), value, intent(in) :: n character(kind=c_char), dimension(2), intent(in) :: which - integer(kind=c_int), value, intent(in) :: nev + integer(kind=i_int), value, intent(in) :: nev real(kind=c_float), value, intent(in) :: tol complex(kind=c_float_complex),dimension(n), intent(inout) :: resid - integer(kind=c_int), value, intent(in) :: ncv + integer(kind=i_int), value, intent(in) :: ncv complex(kind=c_float_complex),dimension(ldv, ncv),intent(out) :: v - integer(kind=c_int), value, intent(in) :: ldv - integer(kind=c_int), dimension(11), intent(inout) :: iparam - integer(kind=c_int), dimension(11), intent(out) :: ipntr + integer(kind=i_int), value, intent(in) :: ldv + integer(kind=i_int), dimension(11), intent(inout) :: iparam + integer(kind=i_int), dimension(14), intent(out) :: ipntr complex(kind=c_float_complex),dimension(3*n), intent(out) :: workd complex(kind=c_float_complex),dimension(lworkl), intent(out) :: workl - integer(kind=c_int), value, intent(in) :: lworkl + integer(kind=i_int), value, intent(in) :: lworkl real(kind=c_float), dimension(ncv), intent(out) :: rwork - integer(kind=c_int), intent(inout) :: info - call cnaupd(ido, bmat, n, which, nev, tol, resid, ncv, v, ldv,& + integer(kind=i_int), intent(inout) :: info + + character(len=2):: w + integer :: i + + do i =1,2 + w(i:i) = which(i) + end do + + call cnaupd(ido, bmat, n, w, nev, tol, resid, ncv, v, ldv,& iparam, ipntr, workd, workl, lworkl, rwork, info) end subroutine cnaupd_c @@ -33,32 +41,54 @@ bind(c, name="cneupd_c") use :: iso_c_binding implicit none -#include "arpackdef.h" - logical(kind=c_bool), value, intent(in) :: rvec - character(kind=c_char), dimension(1), intent(in) :: howmny - logical(kind=c_bool), dimension(ncv), intent(in) :: select +#include "arpackicb.h" + integer(kind=i_int), value, intent(in) :: rvec + character(kind=c_char), intent(in) :: howmny + integer(kind=i_int), dimension(ncv), intent(in) :: select complex(kind=c_float_complex),dimension(nev), intent(out) :: d complex(kind=c_float_complex),dimension(n, nev), intent(out) :: z - integer(kind=c_int), value, intent(in) :: ldz + integer(kind=i_int), value, intent(in) :: ldz complex(kind=c_float_complex),value, intent(in) :: sigma complex(kind=c_float_complex),dimension(2*ncv), intent(out) :: workev - character(kind=c_char), dimension(1), intent(in) :: bmat - integer(kind=c_int), value, intent(in) :: n + character(kind=c_char), intent(in) :: bmat + integer(kind=i_int), value, intent(in) :: n character(kind=c_char), dimension(2), intent(in) :: which - integer(kind=c_int), value, intent(in) :: nev + integer(kind=i_int), value, intent(in) :: nev real(kind=c_float), value, intent(in) :: tol complex(kind=c_float_complex),dimension(n), intent(inout) :: resid - integer(kind=c_int), value, intent(in) :: ncv + integer(kind=i_int), value, intent(in) :: ncv complex(kind=c_float_complex),dimension(ldv, ncv),intent(out) :: v - integer(kind=c_int), value, intent(in) :: ldv - integer(kind=c_int), dimension(11), intent(inout) :: iparam - integer(kind=c_int), dimension(11), intent(out) :: ipntr + integer(kind=i_int), value, intent(in) :: ldv + integer(kind=i_int), dimension(11), intent(inout) :: iparam + integer(kind=i_int), dimension(14), intent(out) :: ipntr complex(kind=c_float_complex),dimension(3*n), intent(out) :: workd complex(kind=c_float_complex),dimension(lworkl), intent(out) :: workl - integer(kind=c_int), value, intent(in) :: lworkl + integer(kind=i_int), value, intent(in) :: lworkl real(kind=c_float), dimension(ncv), intent(out) :: rwork - integer(kind=c_int), intent(inout) :: info - call cneupd(rvec, howmny, select, d, z, ldz, sigma, workev,& - bmat, n, which, nev, tol, resid, ncv, v, ldv, & + integer(kind=i_int), intent(inout) :: info + + ! convert parameters if needed. + + logical :: rv + logical, dimension(ncv) :: slt + integer :: idx + character(len=2):: w + integer :: i + + rv = .false. + if (rvec .ne. 0) rv = .true. + + slt = .false. + do idx=1, ncv + if (select(idx) .ne. 0) slt(idx) = .true. + enddo + + do i =1,2 + w(i:i) = which(i) + end do + ! call arpack. + + call cneupd(rv, howmny, slt, d, z, ldz, sigma, workev, & + bmat, n, w, nev, tol, resid, ncv, v, ldv, & iparam, ipntr, workd, workl, lworkl, rwork, info) end subroutine cneupd_c diff -Nru arpack-3.7.0/SRC/icbadn.F90 arpack-3.8.0/SRC/icbadn.F90 --- arpack-3.7.0/SRC/icbadn.F90 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/SRC/icbadn.F90 2020-12-07 10:40:45.000000000 +0000 @@ -5,24 +5,32 @@ bind(c, name="dnaupd_c") use :: iso_c_binding implicit none -#include "arpackdef.h" - integer(kind=c_int), intent(inout) :: ido - character(kind=c_char), dimension(1), intent(in) :: bmat - integer(kind=c_int), value, intent(in) :: n +#include "arpackicb.h" + integer(kind=i_int), intent(inout) :: ido + character(kind=c_char), intent(in) :: bmat + integer(kind=i_int), value, intent(in) :: n character(kind=c_char), dimension(2), intent(in) :: which - integer(kind=c_int), value, intent(in) :: nev + integer(kind=i_int), value, intent(in) :: nev real(kind=c_double), value, intent(in) :: tol real(kind=c_double), dimension(n), intent(inout) :: resid - integer(kind=c_int), value, intent(in) :: ncv + integer(kind=i_int), value, intent(in) :: ncv real(kind=c_double), dimension(ldv, ncv), intent(out) :: v - integer(kind=c_int), value, intent(in) :: ldv - integer(kind=c_int), dimension(11), intent(inout) :: iparam - integer(kind=c_int), dimension(11), intent(out) :: ipntr + integer(kind=i_int), value, intent(in) :: ldv + integer(kind=i_int), dimension(11), intent(inout) :: iparam + integer(kind=i_int), dimension(14), intent(out) :: ipntr real(kind=c_double), dimension(3*n), intent(out) :: workd real(kind=c_double), dimension(lworkl), intent(out) :: workl - integer(kind=c_int), value, intent(in) :: lworkl - integer(kind=c_int), intent(inout) :: info - call dnaupd(ido, bmat, n, which, nev, tol, resid, ncv, v, ldv,& + integer(kind=i_int), value, intent(in) :: lworkl + integer(kind=i_int), intent(inout) :: info + + character(len=2):: w + integer :: i + + do i =1,2 + w(i:i) = which(i) + end do + + call dnaupd(ido, bmat, n, w, nev, tol, resid, ncv, v, ldv,& iparam, ipntr, workd, workl, lworkl, info) end subroutine dnaupd_c @@ -33,34 +41,57 @@ bind(c, name="dneupd_c") use :: iso_c_binding implicit none -#include "arpackdef.h" - logical(kind=c_bool), value, intent(in) :: rvec - character(kind=c_char), dimension(1), intent(in) :: howmny - logical(kind=c_bool), dimension(ncv), intent(in) :: select +#include "arpackicb.h" + integer(kind=i_int), value, intent(in) :: rvec + character(kind=c_char), intent(in) :: howmny + integer(kind=i_int), dimension(ncv), intent(in) :: select real(kind=c_double), dimension(nev+1), intent(out) :: dr real(kind=c_double), dimension(nev+1), intent(out) :: di real(kind=c_double), dimension(n, nev+1), intent(out) :: z - integer(kind=c_int), value, intent(in) :: ldz + integer(kind=i_int), value, intent(in) :: ldz real(kind=c_double), value, intent(in) :: sigmar real(kind=c_double), value, intent(in) :: sigmai real(kind=c_double), dimension(3*ncv), intent(out) :: workev - character(kind=c_char), dimension(1), intent(in) :: bmat - integer(kind=c_int), value, intent(in) :: n + character(kind=c_char), intent(in) :: bmat + integer(kind=i_int), value, intent(in) :: n character(kind=c_char), dimension(2), intent(in) :: which - integer(kind=c_int), value, intent(in) :: nev + integer(kind=i_int), value, intent(in) :: nev real(kind=c_double), value, intent(in) :: tol real(kind=c_double), dimension(n), intent(inout) :: resid - integer(kind=c_int), value, intent(in) :: ncv + integer(kind=i_int), value, intent(in) :: ncv real(kind=c_double), dimension(ldv, ncv), intent(out) :: v - integer(kind=c_int), value, intent(in) :: ldv - integer(kind=c_int), dimension(11), intent(inout) :: iparam - integer(kind=c_int), dimension(11), intent(out) :: ipntr + integer(kind=i_int), value, intent(in) :: ldv + integer(kind=i_int), dimension(11), intent(inout) :: iparam + integer(kind=i_int), dimension(14), intent(out) :: ipntr real(kind=c_double), dimension(3*n), intent(out) :: workd real(kind=c_double), dimension(lworkl), intent(out) :: workl - integer(kind=c_int), value, intent(in) :: lworkl - integer(kind=c_int), intent(inout) :: info - call dneupd(rvec, howmny, select, & + integer(kind=i_int), value, intent(in) :: lworkl + integer(kind=i_int), intent(inout) :: info + + ! convert parameters if needed. + + logical :: rv + logical, dimension(ncv) :: slt + integer :: idx + character(len=2):: w + integer :: i + + rv = .false. + if (rvec .ne. 0) rv = .true. + + slt = .false. + do idx=1, ncv + if (select(idx) .ne. 0) slt(idx) = .true. + enddo + + do i =1,2 + w(i:i) = which(i) + end do + + ! call arpack. + + call dneupd(rv, howmny, slt, & dr, di, z, ldz, sigmar, sigmai, workev, & - bmat, n, which, nev, tol, resid, ncv, v, ldv,& + bmat, n, w, nev, tol, resid, ncv, v, ldv,& iparam, ipntr, workd, workl, lworkl, info) end subroutine dneupd_c diff -Nru arpack-3.7.0/SRC/icbads.F90 arpack-3.8.0/SRC/icbads.F90 --- arpack-3.7.0/SRC/icbads.F90 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/SRC/icbads.F90 2020-12-07 10:40:45.000000000 +0000 @@ -5,24 +5,32 @@ bind(c, name="dsaupd_c") use :: iso_c_binding implicit none -#include "arpackdef.h" - integer(kind=c_int), intent(inout) :: ido - character(kind=c_char), dimension(1), intent(in) :: bmat - integer(kind=c_int), value, intent(in) :: n +#include "arpackicb.h" + integer(kind=i_int), intent(inout) :: ido + character(kind=c_char), intent(in) :: bmat + integer(kind=i_int), value, intent(in) :: n character(kind=c_char), dimension(2), intent(in) :: which - integer(kind=c_int), value, intent(in) :: nev + integer(kind=i_int), value, intent(in) :: nev real(kind=c_double), value, intent(in) :: tol real(kind=c_double), dimension(n), intent(inout) :: resid - integer(kind=c_int), value, intent(in) :: ncv + integer(kind=i_int), value, intent(in) :: ncv real(kind=c_double), dimension(ldv, ncv), intent(out) :: v - integer(kind=c_int), value, intent(in) :: ldv - integer(kind=c_int), dimension(11), intent(inout) :: iparam - integer(kind=c_int), dimension(11), intent(out) :: ipntr + integer(kind=i_int), value, intent(in) :: ldv + integer(kind=i_int), dimension(11), intent(inout) :: iparam + integer(kind=i_int), dimension(11), intent(out) :: ipntr real(kind=c_double), dimension(3*n), intent(out) :: workd real(kind=c_double), dimension(lworkl), intent(out) :: workl - integer(kind=c_int), value, intent(in) :: lworkl - integer(kind=c_int), intent(inout) :: info - call dsaupd(ido, bmat, n, which, nev, tol, resid, ncv, v, ldv,& + integer(kind=i_int), value, intent(in) :: lworkl + integer(kind=i_int), intent(inout) :: info + + character(len=2):: w + integer :: i + + do i =1,2 + w(i:i) = which(i) + end do + + call dsaupd(ido, bmat, n, w, nev, tol, resid, ncv, v, ldv,& iparam, ipntr, workd, workl, lworkl, info) end subroutine dsaupd_c @@ -32,30 +40,53 @@ bind(c, name="dseupd_c") use :: iso_c_binding implicit none -#include "arpackdef.h" - logical(kind=c_bool), value, intent(in) :: rvec - character(kind=c_char), dimension(1), intent(in) :: howmny - logical(kind=c_bool), dimension(ncv), intent(in) :: select +#include "arpackicb.h" + integer(kind=i_int), value, intent(in) :: rvec + character(kind=c_char), intent(in) :: howmny + integer(kind=i_int), dimension(ncv), intent(in) :: select real(kind=c_double), dimension(nev), intent(out) :: d real(kind=c_double), dimension(n, nev), intent(out) :: z - integer(kind=c_int), value, intent(in) :: ldz + integer(kind=i_int), value, intent(in) :: ldz real(kind=c_double), value, intent(in) :: sigma - character(kind=c_char), dimension(1), intent(in) :: bmat - integer(kind=c_int), value, intent(in) :: n + character(kind=c_char), intent(in) :: bmat + integer(kind=i_int), value, intent(in) :: n character(kind=c_char), dimension(2), intent(in) :: which - integer(kind=c_int), value, intent(in) :: nev + integer(kind=i_int), value, intent(in) :: nev real(kind=c_double), value, intent(in) :: tol real(kind=c_double), dimension(n), intent(inout) :: resid - integer(kind=c_int), value, intent(in) :: ncv + integer(kind=i_int), value, intent(in) :: ncv real(kind=c_double), dimension(ldv, ncv), intent(out) :: v - integer(kind=c_int), value, intent(in) :: ldv - integer(kind=c_int), dimension(11), intent(inout) :: iparam - integer(kind=c_int), dimension(11), intent(out) :: ipntr + integer(kind=i_int), value, intent(in) :: ldv + integer(kind=i_int), dimension(7), intent(inout) :: iparam + integer(kind=i_int), dimension(11), intent(out) :: ipntr real(kind=c_double), dimension(3*n), intent(out) :: workd real(kind=c_double), dimension(lworkl), intent(out) :: workl - integer(kind=c_int), value, intent(in) :: lworkl - integer(kind=c_int), intent(inout) :: info - call dseupd(rvec, howmny, select, d, z, ldz, sigma, & - bmat, n, which, nev, tol, resid, ncv, v, ldv,& + integer(kind=i_int), value, intent(in) :: lworkl + integer(kind=i_int), intent(inout) :: info + + ! convert parameters if needed. + + logical :: rv + logical, dimension(ncv) :: slt + integer :: idx + character(len=2):: w + integer :: i + + rv = .false. + if (rvec .ne. 0) rv = .true. + + slt = .false. + do idx=1, ncv + if (select(idx) .ne. 0) slt(idx) = .true. + enddo + + do i =1,2 + w(i:i) = which(i) + end do + + ! call arpack. + + call dseupd(rv, howmny, slt, d, z, ldz, sigma, & + bmat, n, w, nev, tol, resid, ncv, v, ldv,& iparam, ipntr, workd, workl, lworkl, info) end subroutine dseupd_c diff -Nru arpack-3.7.0/SRC/icbasn.F90 arpack-3.8.0/SRC/icbasn.F90 --- arpack-3.7.0/SRC/icbasn.F90 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/SRC/icbasn.F90 2020-12-07 10:40:45.000000000 +0000 @@ -5,24 +5,32 @@ bind(c, name="snaupd_c") use :: iso_c_binding implicit none -#include "arpackdef.h" - integer(kind=c_int), intent(inout) :: ido - character(kind=c_char), dimension(1), intent(in) :: bmat - integer(kind=c_int), value, intent(in) :: n +#include "arpackicb.h" + integer(kind=i_int), intent(inout) :: ido + character(kind=c_char), intent(in) :: bmat + integer(kind=i_int), value, intent(in) :: n character(kind=c_char), dimension(2), intent(in) :: which - integer(kind=c_int), value, intent(in) :: nev + integer(kind=i_int), value, intent(in) :: nev real(kind=c_float), value, intent(in) :: tol real(kind=c_float), dimension(n), intent(inout) :: resid - integer(kind=c_int), value, intent(in) :: ncv + integer(kind=i_int), value, intent(in) :: ncv real(kind=c_float), dimension(ldv, ncv), intent(out) :: v - integer(kind=c_int), value, intent(in) :: ldv - integer(kind=c_int), dimension(11), intent(inout) :: iparam - integer(kind=c_int), dimension(11), intent(out) :: ipntr + integer(kind=i_int), value, intent(in) :: ldv + integer(kind=i_int), dimension(11), intent(inout) :: iparam + integer(kind=i_int), dimension(14), intent(out) :: ipntr real(kind=c_float), dimension(3*n), intent(out) :: workd real(kind=c_float), dimension(lworkl), intent(out) :: workl - integer(kind=c_int), value, intent(in) :: lworkl - integer(kind=c_int), intent(inout) :: info - call snaupd(ido, bmat, n, which, nev, tol, resid, ncv, v, ldv,& + integer(kind=i_int), value, intent(in) :: lworkl + integer(kind=i_int), intent(inout) :: info + + character(len=2):: w + integer :: i + + do i =1,2 + w(i:i) = which(i) + end do + + call snaupd(ido, bmat, n, w, nev, tol, resid, ncv, v, ldv,& iparam, ipntr, workd, workl, lworkl, info) end subroutine snaupd_c @@ -33,34 +41,56 @@ bind(c, name="sneupd_c") use :: iso_c_binding implicit none -#include "arpackdef.h" - logical(kind=c_bool), value, intent(in) :: rvec - character(kind=c_char), dimension(1), intent(in) :: howmny - logical(kind=c_bool), dimension(ncv), intent(in) :: select +#include "arpackicb.h" + integer(kind=i_int), value, intent(in) :: rvec + character(kind=c_char), intent(in) :: howmny + integer(kind=i_int), dimension(ncv), intent(in) :: select real(kind=c_float), dimension(nev+1), intent(out) :: dr real(kind=c_float), dimension(nev+1), intent(out) :: di real(kind=c_float), dimension(n, nev+1), intent(out) :: z - integer(kind=c_int), value, intent(in) :: ldz + integer(kind=i_int), value, intent(in) :: ldz real(kind=c_float), value, intent(in) :: sigmar real(kind=c_float), value, intent(in) :: sigmai real(kind=c_float), dimension(3*ncv), intent(out) :: workev - character(kind=c_char), dimension(1), intent(in) :: bmat - integer(kind=c_int), value, intent(in) :: n + character(kind=c_char), intent(in) :: bmat + integer(kind=i_int), value, intent(in) :: n character(kind=c_char), dimension(2), intent(in) :: which - integer(kind=c_int), value, intent(in) :: nev + integer(kind=i_int), value, intent(in) :: nev real(kind=c_float), value, intent(in) :: tol real(kind=c_float), dimension(n), intent(inout) :: resid - integer(kind=c_int), value, intent(in) :: ncv + integer(kind=i_int), value, intent(in) :: ncv real(kind=c_float), dimension(ldv, ncv), intent(out) :: v - integer(kind=c_int), value, intent(in) :: ldv - integer(kind=c_int), dimension(11), intent(inout) :: iparam - integer(kind=c_int), dimension(11), intent(out) :: ipntr + integer(kind=i_int), value, intent(in) :: ldv + integer(kind=i_int), dimension(11), intent(inout) :: iparam + integer(kind=i_int), dimension(14), intent(out) :: ipntr real(kind=c_float), dimension(3*n), intent(out) :: workd real(kind=c_float), dimension(lworkl), intent(out) :: workl - integer(kind=c_int), value, intent(in) :: lworkl - integer(kind=c_int), intent(inout) :: info - call sneupd(rvec, howmny, select, & + integer(kind=i_int), value, intent(in) :: lworkl + integer(kind=i_int), intent(inout) :: info + + ! convert parameters if needed. + + logical :: rv + logical, dimension(ncv) :: slt + integer :: idx + character(len=2):: w + integer :: i + + rv = .false. + if (rvec .ne. 0) rv = .true. + + slt = .false. + do idx=1, ncv + if (select(idx) .ne. 0) slt(idx) = .true. + enddo + + do i =1,2 + w(i:i) = which(i) + end do + ! call arpack. + + call sneupd(rv, howmny, slt, & dr, di, z, ldz, sigmar, sigmai, workev, & - bmat, n, which, nev, tol, resid, ncv, v, ldv,& + bmat, n, w, nev, tol, resid, ncv, v, ldv,& iparam, ipntr, workd, workl, lworkl, info) end subroutine sneupd_c diff -Nru arpack-3.7.0/SRC/icbass.F90 arpack-3.8.0/SRC/icbass.F90 --- arpack-3.7.0/SRC/icbass.F90 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/SRC/icbass.F90 2020-12-07 10:40:45.000000000 +0000 @@ -5,24 +5,32 @@ bind(c, name="ssaupd_c") use :: iso_c_binding implicit none -#include "arpackdef.h" - integer(kind=c_int), intent(inout) :: ido - character(kind=c_char), dimension(1), intent(in) :: bmat - integer(kind=c_int), value, intent(in) :: n +#include "arpackicb.h" + integer(kind=i_int), intent(inout) :: ido + character(kind=c_char), intent(in) :: bmat + integer(kind=i_int), value, intent(in) :: n character(kind=c_char), dimension(2), intent(in) :: which - integer(kind=c_int), value, intent(in) :: nev + integer(kind=i_int), value, intent(in) :: nev real(kind=c_float), value, intent(in) :: tol real(kind=c_float), dimension(n), intent(inout) :: resid - integer(kind=c_int), value, intent(in) :: ncv + integer(kind=i_int), value, intent(in) :: ncv real(kind=c_float), dimension(ldv, ncv), intent(out) :: v - integer(kind=c_int), value, intent(in) :: ldv - integer(kind=c_int), dimension(11), intent(inout) :: iparam - integer(kind=c_int), dimension(11), intent(out) :: ipntr + integer(kind=i_int), value, intent(in) :: ldv + integer(kind=i_int), dimension(11), intent(inout) :: iparam + integer(kind=i_int), dimension(11), intent(out) :: ipntr real(kind=c_float), dimension(3*n), intent(out) :: workd real(kind=c_float), dimension(lworkl), intent(out) :: workl - integer(kind=c_int), value, intent(in) :: lworkl - integer(kind=c_int), intent(inout) :: info - call ssaupd(ido, bmat, n, which, nev, tol, resid, ncv, v, ldv,& + integer(kind=i_int), value, intent(in) :: lworkl + integer(kind=i_int), intent(inout) :: info + + character(len=2):: w + integer :: i + + do i =1,2 + w(i:i) = which(i) + end do + + call ssaupd(ido, bmat, n, w, nev, tol, resid, ncv, v, ldv,& iparam, ipntr, workd, workl, lworkl, info) end subroutine ssaupd_c @@ -32,30 +40,53 @@ bind(c, name="sseupd_c") use :: iso_c_binding implicit none -#include "arpackdef.h" - logical(kind=c_bool), value, intent(in) :: rvec - character(kind=c_char), dimension(1), intent(in) :: howmny - logical(kind=c_bool), dimension(ncv), intent(in) :: select +#include "arpackicb.h" + integer(kind=i_int), value, intent(in) :: rvec + character(kind=c_char), intent(in) :: howmny + integer(kind=i_int), dimension(ncv), intent(in) :: select real(kind=c_float), dimension(nev), intent(out) :: d real(kind=c_float), dimension(n, nev), intent(out) :: z - integer(kind=c_int), value, intent(in) :: ldz + integer(kind=i_int), value, intent(in) :: ldz real(kind=c_float), value, intent(in) :: sigma - character(kind=c_char), dimension(1), intent(in) :: bmat - integer(kind=c_int), value, intent(in) :: n + character(kind=c_char), intent(in) :: bmat + integer(kind=i_int), value, intent(in) :: n character(kind=c_char), dimension(2), intent(in) :: which - integer(kind=c_int), value, intent(in) :: nev + integer(kind=i_int), value, intent(in) :: nev real(kind=c_float), value, intent(in) :: tol real(kind=c_float), dimension(n), intent(inout) :: resid - integer(kind=c_int), value, intent(in) :: ncv + integer(kind=i_int), value, intent(in) :: ncv real(kind=c_float), dimension(ldv, ncv), intent(out) :: v - integer(kind=c_int), value, intent(in) :: ldv - integer(kind=c_int), dimension(11), intent(inout) :: iparam - integer(kind=c_int), dimension(11), intent(out) :: ipntr + integer(kind=i_int), value, intent(in) :: ldv + integer(kind=i_int), dimension(7), intent(inout) :: iparam + integer(kind=i_int), dimension(11), intent(out) :: ipntr real(kind=c_float), dimension(3*n), intent(out) :: workd real(kind=c_float), dimension(lworkl), intent(out) :: workl - integer(kind=c_int), value, intent(in) :: lworkl - integer(kind=c_int), intent(inout) :: info - call sseupd(rvec, howmny, select, d, z, ldz, sigma, & - bmat, n, which, nev, tol, resid, ncv, v, ldv,& + integer(kind=i_int), value, intent(in) :: lworkl + integer(kind=i_int), intent(inout) :: info + + ! convert parameters if needed. + + logical :: rv + logical, dimension(ncv) :: slt + integer :: idx + character(len=2):: w + integer :: i + + rv = .false. + if (rvec .ne. 0) rv = .true. + + slt = .false. + do idx=1, ncv + if (select(idx) .ne. 0) slt(idx) = .true. + enddo + + do i =1,2 + w(i:i) = which(i) + end do + + ! call arpack. + + call sseupd(rv, howmny, slt, d, z, ldz, sigma, & + bmat, n, w, nev, tol, resid, ncv, v, ldv,& iparam, ipntr, workd, workl, lworkl, info) end subroutine sseupd_c diff -Nru arpack-3.7.0/SRC/icbazn.F90 arpack-3.8.0/SRC/icbazn.F90 --- arpack-3.7.0/SRC/icbazn.F90 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/SRC/icbazn.F90 2020-12-07 10:40:45.000000000 +0000 @@ -5,25 +5,33 @@ bind(c, name="znaupd_c") use :: iso_c_binding implicit none -#include "arpackdef.h" - integer(kind=c_int), intent(inout) :: ido - character(kind=c_char), dimension(1), intent(in) :: bmat - integer(kind=c_int), value, intent(in) :: n +#include "arpackicb.h" + integer(kind=i_int), intent(inout) :: ido + character(kind=c_char), intent(in) :: bmat + integer(kind=i_int), value, intent(in) :: n character(kind=c_char), dimension(2), intent(in) :: which - integer(kind=c_int), value, intent(in) :: nev + integer(kind=i_int), value, intent(in) :: nev real(kind=c_double), value, intent(in) :: tol complex(kind=c_double_complex), dimension(n), intent(inout) :: resid - integer(kind=c_int), value, intent(in) :: ncv + integer(kind=i_int), value, intent(in) :: ncv complex(kind=c_double_complex), dimension(ldv, ncv),intent(out) :: v - integer(kind=c_int), value, intent(in) :: ldv - integer(kind=c_int), dimension(11), intent(inout) :: iparam - integer(kind=c_int), dimension(11), intent(out) :: ipntr + integer(kind=i_int), value, intent(in) :: ldv + integer(kind=i_int), dimension(11), intent(inout) :: iparam + integer(kind=i_int), dimension(14), intent(out) :: ipntr complex(kind=c_double_complex), dimension(3*n), intent(out) :: workd complex(kind=c_double_complex), dimension(lworkl), intent(out) :: workl - integer(kind=c_int), value, intent(in) :: lworkl + integer(kind=i_int), value, intent(in) :: lworkl real(kind=c_double), dimension(ncv), intent(out) :: rwork - integer(kind=c_int), intent(inout) :: info - call znaupd(ido, bmat, n, which, nev, tol, resid, ncv, v, ldv,& + integer(kind=i_int), intent(inout) :: info + + character(len=2):: w + integer :: i + + do i =1,2 + w(i:i) = which(i) + end do + + call znaupd(ido, bmat, n, w, nev, tol, resid, ncv, v, ldv,& iparam, ipntr, workd, workl, lworkl, rwork, info) end subroutine znaupd_c @@ -33,32 +41,54 @@ bind(c, name="zneupd_c") use :: iso_c_binding implicit none -#include "arpackdef.h" - logical(kind=c_bool), value, intent(in) :: rvec - character(kind=c_char), dimension(1), intent(in) :: howmny - logical(kind=c_bool), dimension(ncv), intent(in) :: select +#include "arpackicb.h" + integer(kind=i_int), value, intent(in) :: rvec + character(kind=c_char), intent(in) :: howmny + integer(kind=i_int), dimension(ncv), intent(in) :: select complex(kind=c_double_complex), dimension(nev), intent(out) :: d complex(kind=c_double_complex), dimension(n, nev), intent(out) :: z - integer(kind=c_int), value, intent(in) :: ldz + integer(kind=i_int), value, intent(in) :: ldz complex(kind=c_double_complex), value, intent(in) :: sigma complex(kind=c_double_complex), dimension(2*ncv), intent(out) :: workev - character(kind=c_char), dimension(1), intent(in) :: bmat - integer(kind=c_int), value, intent(in) :: n + character(kind=c_char), intent(in) :: bmat + integer(kind=i_int), value, intent(in) :: n character(kind=c_char), dimension(2), intent(in) :: which - integer(kind=c_int), value, intent(in) :: nev + integer(kind=i_int), value, intent(in) :: nev real(kind=c_double), value, intent(in) :: tol complex(kind=c_double_complex), dimension(n), intent(inout) :: resid - integer(kind=c_int), value, intent(in) :: ncv + integer(kind=i_int), value, intent(in) :: ncv complex(kind=c_double_complex), dimension(ldv, ncv),intent(out) :: v - integer(kind=c_int), value, intent(in) :: ldv - integer(kind=c_int), dimension(11), intent(inout) :: iparam - integer(kind=c_int), dimension(11), intent(out) :: ipntr + integer(kind=i_int), value, intent(in) :: ldv + integer(kind=i_int), dimension(11), intent(inout) :: iparam + integer(kind=i_int), dimension(14), intent(out) :: ipntr complex(kind=c_double_complex), dimension(3*n), intent(out) :: workd complex(kind=c_double_complex), dimension(lworkl), intent(out) :: workl - integer(kind=c_int), value, intent(in) :: lworkl + integer(kind=i_int), value, intent(in) :: lworkl real(kind=c_double), dimension(ncv), intent(out) :: rwork - integer(kind=c_int), intent(inout) :: info - call zneupd(rvec, howmny, select, d, z, ldz, sigma, workev,& - bmat, n, which, nev, tol, resid, ncv, v, ldv, & + integer(kind=i_int), intent(inout) :: info + + ! convert parameters if needed. + + logical :: rv + logical, dimension(ncv) :: slt + integer :: idx + character(len=2):: w + integer :: i + + rv = .false. + if (rvec .ne. 0) rv = .true. + + slt = .false. + do idx=1, ncv + if (select(idx) .ne. 0) slt(idx) = .true. + enddo + + do i =1,2 + w(i:i) = which(i) + end do + ! call arpack. + + call zneupd(rv, howmny, slt, d, z, ldz, sigma, workev, & + bmat, n, w, nev, tol, resid, ncv, v, ldv, & iparam, ipntr, workd, workl, lworkl, rwork, info) end subroutine zneupd_c diff -Nru arpack-3.7.0/SRC/Makefile.am arpack-3.8.0/SRC/Makefile.am --- arpack-3.7.0/SRC/Makefile.am 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/SRC/Makefile.am 2020-12-07 10:40:45.000000000 +0000 @@ -33,3 +33,8 @@ libarpack@LIBSUFFIX@_la_LIBADD += $(top_builddir)/ICB/libdbgicb.la $(top_builddir)/ICB/libstaicb.la libarpack@LIBSUFFIX@_la_CPPFLAGS = $(AM_CPPFLAGS) -I$(top_builddir) endif + +pkgconfig_DATA = arpack@LIBSUFFIX@.pc + +# Due to the LIBSUFFIX, configure doesn't automatically clean this file: +DISTCLEANFILES = arpack@LIBSUFFIX@.pc diff -Nru arpack-3.7.0/SRC/sgetv0.f arpack-3.8.0/SRC/sgetv0.f --- arpack-3.7.0/SRC/sgetv0.f 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/SRC/sgetv0.f 2020-12-07 10:40:45.000000000 +0000 @@ -366,9 +366,9 @@ c %--------------------------------------% c if (msglvl .gt. 2) then - call svout (logfil, 1, rnorm0, ndigit, + call svout (logfil, 1, [rnorm0], ndigit, & '_getv0: re-orthonalization ; rnorm0 is') - call svout (logfil, 1, rnorm, ndigit, + call svout (logfil, 1, [rnorm], ndigit, & '_getv0: re-orthonalization ; rnorm is') end if c @@ -399,7 +399,7 @@ 50 continue c if (msglvl .gt. 0) then - call svout (logfil, 1, rnorm, ndigit, + call svout (logfil, 1, [rnorm], ndigit, & '_getv0: B-norm of initial / restarted starting vector') end if if (msglvl .gt. 3) then diff -Nru arpack-3.7.0/SRC/snaitr.f arpack-3.8.0/SRC/snaitr.f --- arpack-3.7.0/SRC/snaitr.f 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/SRC/snaitr.f 2020-12-07 10:40:45.000000000 +0000 @@ -371,9 +371,9 @@ 1000 continue c if (msglvl .gt. 1) then - call ivout (logfil, 1, j, ndigit, + call ivout (logfil, 1, [j], ndigit, & '_naitr: generating Arnoldi vector number') - call svout (logfil, 1, rnorm, ndigit, + call svout (logfil, 1, [rnorm], ndigit, & '_naitr: B-norm of the current residual is') end if c @@ -393,7 +393,7 @@ c %---------------------------------------------------% c if (msglvl .gt. 0) then - call ivout (logfil, 1, j, ndigit, + call ivout (logfil, 1, [j], ndigit, & '_naitr: ****** RESTART AT STEP ******') end if c @@ -721,7 +721,7 @@ end if c if (msglvl .gt. 0 .and. iter .gt. 0) then - call ivout (logfil, 1, j, ndigit, + call ivout (logfil, 1, [j], ndigit, & '_naitr: Iterative refinement for Arnoldi residual') if (msglvl .gt. 2) then xtemp(1) = rnorm diff -Nru arpack-3.7.0/SRC/snapps.f arpack-3.8.0/SRC/snapps.f --- arpack-3.7.0/SRC/snapps.f 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/SRC/snapps.f 2020-12-07 10:40:45.000000000 +0000 @@ -266,11 +266,11 @@ sigmai = shifti(jj) c if (msglvl .gt. 2 ) then - call ivout (logfil, 1, jj, ndigit, + call ivout (logfil, 1, [jj], ndigit, & '_napps: shift number.') - call svout (logfil, 1, sigmar, ndigit, + call svout (logfil, 1, [sigmar], ndigit, & '_napps: The real part of the shift ') - call svout (logfil, 1, sigmai, ndigit, + call svout (logfil, 1, [sigmai], ndigit, & '_napps: The imaginary part of the shift ') end if c @@ -335,9 +335,9 @@ & tst1 = slanhs( '1', kplusp-jj+1, h, ldh, workl ) if( abs( h( i+1,i ) ).le.max( ulp*tst1, smlnum ) ) then if (msglvl .gt. 0) then - call ivout (logfil, 1, i, ndigit, + call ivout (logfil, 1, [i], ndigit, & '_napps: matrix splitting at row/column no.') - call ivout (logfil, 1, jj, ndigit, + call ivout (logfil, 1, [jj], ndigit, & '_napps: matrix splitting with shift number.') call svout (logfil, 1, h(i+1,i), ndigit, & '_napps: off diagonal element.') @@ -351,9 +351,9 @@ 40 continue c if (msglvl .gt. 2) then - call ivout (logfil, 1, istart, ndigit, + call ivout (logfil, 1, [istart], ndigit, & '_napps: Start of current block ') - call ivout (logfil, 1, iend, ndigit, + call ivout (logfil, 1, [iend], ndigit, & '_napps: End of current block ') end if c @@ -625,7 +625,7 @@ & '_napps: sigmak = (e_{kev+p}^T*Q)*e_{kev}') call svout (logfil, 1, h(kev+1,kev), ndigit, & '_napps: betak = e_{kev+1}^T*H*e_{kev}') - call ivout (logfil, 1, kev, ndigit, + call ivout (logfil, 1, [kev], ndigit, & '_napps: Order of the final Hessenberg matrix ') if (msglvl .gt. 2) then call smout (logfil, kev, kev, h, ldh, ndigit, diff -Nru arpack-3.7.0/SRC/snaup2.f arpack-3.8.0/SRC/snaup2.f --- arpack-3.7.0/SRC/snaup2.f 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/SRC/snaup2.f 2020-12-07 10:40:45.000000000 +0000 @@ -388,7 +388,7 @@ iter = iter + 1 c if (msglvl .gt. 0) then - call ivout (logfil, 1, iter, ndigit, + call ivout (logfil, 1, [iter], ndigit, & '_naup2: **** Start of major iteration number ****') end if c @@ -401,9 +401,9 @@ np = kplusp - nev c if (msglvl .gt. 1) then - call ivout (logfil, 1, nev, ndigit, + call ivout (logfil, 1, [nev], ndigit, & '_naup2: The length of the current Arnoldi factorization') - call ivout (logfil, 1, np, ndigit, + call ivout (logfil, 1, [np], ndigit, & '_naup2: Extend the Arnoldi factorization by') end if c @@ -435,7 +435,7 @@ update = .false. c if (msglvl .gt. 1) then - call svout (logfil, 1, rnorm, ndigit, + call svout (logfil, 1, [rnorm], ndigit, & '_naup2: Corresponding B-norm of the residual') end if c @@ -690,7 +690,7 @@ end if c if (msglvl .gt. 0) then - call ivout (logfil, 1, nconv, ndigit, + call ivout (logfil, 1, [nconv], ndigit, & '_naup2: no. of "converged" Ritz values at this iter.') if (msglvl .gt. 1) then kp(1) = nev @@ -742,7 +742,7 @@ end if c if (msglvl .gt. 2) then - call ivout (logfil, 1, np, ndigit, + call ivout (logfil, 1, [np], ndigit, & '_naup2: The number of shifts to apply ') call svout (logfil, np, ritzr, ndigit, & '_naup2: Real part of the shifts') @@ -808,7 +808,7 @@ cnorm = .false. c if (msglvl .gt. 2) then - call svout (logfil, 1, rnorm, ndigit, + call svout (logfil, 1, [rnorm], ndigit, & '_naup2: B-norm of residual for compressed factorization') call smout (logfil, nev, nev, h, ldh, ndigit, & '_naup2: Compressed upper Hessenberg matrix H') diff -Nru arpack-3.7.0/SRC/snaupd.f arpack-3.8.0/SRC/snaupd.f --- arpack-3.7.0/SRC/snaupd.f 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/SRC/snaupd.f 2020-12-07 10:40:45.000000000 +0000 @@ -628,9 +628,9 @@ if (info .eq. 2) info = 3 c if (msglvl .gt. 0) then - call ivout (logfil, 1, mxiter, ndigit, + call ivout (logfil, 1, [mxiter], ndigit, & '_naupd: Number of update iterations taken') - call ivout (logfil, 1, np, ndigit, + call ivout (logfil, 1, [np], ndigit, & '_naupd: Number of wanted "converged" Ritz values') call svout (logfil, np, workl(ritzr), ndigit, & '_naupd: Real part of the final Ritz values') diff -Nru arpack-3.7.0/SRC/sneupd.f arpack-3.8.0/SRC/sneupd.f --- arpack-3.7.0/SRC/sneupd.f 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/SRC/sneupd.f 2020-12-07 10:40:45.000000000 +0000 @@ -601,9 +601,9 @@ c %-----------------------------------------------------------% c if (msglvl .gt. 2) then - call ivout(logfil, 1, numcnv, ndigit, + call ivout(logfil, 1, [numcnv], ndigit, & '_neupd: Number of specified eigenvalues') - call ivout(logfil, 1, nconv, ndigit, + call ivout(logfil, 1, [nconv], ndigit, & '_neupd: Number of "converged" eigenvalues') end if c diff -Nru arpack-3.7.0/SRC/sngets.f arpack-3.8.0/SRC/sngets.f --- arpack-3.7.0/SRC/sngets.f 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/SRC/sngets.f 2020-12-07 10:40:45.000000000 +0000 @@ -212,8 +212,8 @@ tngets = tngets + (t1 - t0) c if (msglvl .gt. 0) then - call ivout (logfil, 1, kev, ndigit, '_ngets: KEV is') - call ivout (logfil, 1, np, ndigit, '_ngets: NP is') + call ivout (logfil, 1, [kev], ndigit, '_ngets: KEV is') + call ivout (logfil, 1, [np], ndigit, '_ngets: NP is') call svout (logfil, kev+np, ritzr, ndigit, & '_ngets: Eigenvalues of current H matrix -- real part') call svout (logfil, kev+np, ritzi, ndigit, diff -Nru arpack-3.7.0/SRC/ssaitr.f arpack-3.8.0/SRC/ssaitr.f --- arpack-3.7.0/SRC/ssaitr.f 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/SRC/ssaitr.f 2020-12-07 10:40:45.000000000 +0000 @@ -364,9 +364,9 @@ 1000 continue c if (msglvl .gt. 2) then - call ivout (logfil, 1, j, ndigit, + call ivout (logfil, 1, [j], ndigit, & '_saitr: generating Arnoldi vector no.') - call svout (logfil, 1, rnorm, ndigit, + call svout (logfil, 1, [rnorm], ndigit, & '_saitr: B-norm of the current residual =') end if c @@ -384,7 +384,7 @@ c %---------------------------------------------------% c if (msglvl .gt. 0) then - call ivout (logfil, 1, j, ndigit, + call ivout (logfil, 1, [j], ndigit, & '_saitr: ****** restart at step ******') end if c @@ -735,7 +735,7 @@ end if c if (msglvl .gt. 0 .and. iter .gt. 0) then - call ivout (logfil, 1, j, ndigit, + call ivout (logfil, 1, [j], ndigit, & '_saitr: Iterative refinement for Arnoldi residual') if (msglvl .gt. 2) then xtemp(1) = rnorm diff -Nru arpack-3.7.0/SRC/ssapps.f arpack-3.8.0/SRC/ssapps.f --- arpack-3.7.0/SRC/ssapps.f 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/SRC/ssapps.f 2020-12-07 10:40:45.000000000 +0000 @@ -261,9 +261,9 @@ big = abs(h(i,2)) + abs(h(i+1,2)) if (h(i+1,1) .le. epsmch*big) then if (msglvl .gt. 0) then - call ivout (logfil, 1, i, ndigit, + call ivout (logfil, 1, [i], ndigit, & '_sapps: deflation at row/column no.') - call ivout (logfil, 1, jj, ndigit, + call ivout (logfil, 1, [jj], ndigit, & '_sapps: occurred before shift number.') call svout (logfil, 1, h(i+1,1), ndigit, & '_sapps: the corresponding off diagonal element') @@ -432,7 +432,7 @@ big = abs(h(i,2)) + abs(h(i+1,2)) if (h(i+1,1) .le. epsmch*big) then if (msglvl .gt. 0) then - call ivout (logfil, 1, i, ndigit, + call ivout (logfil, 1, [i], ndigit, & '_sapps: deflation at row/column no.') call svout (logfil, 1, h(i+1,1), ndigit, & '_sapps: the corresponding off diagonal element') diff -Nru arpack-3.7.0/SRC/ssaup2.f arpack-3.8.0/SRC/ssaup2.f --- arpack-3.7.0/SRC/ssaup2.f 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/SRC/ssaup2.f 2020-12-07 10:40:45.000000000 +0000 @@ -402,13 +402,13 @@ iter = iter + 1 c if (msglvl .gt. 0) then - call ivout (logfil, 1, iter, ndigit, + call ivout (logfil, 1, [iter], ndigit, & '_saup2: **** Start of major iteration number ****') end if if (msglvl .gt. 1) then - call ivout (logfil, 1, nev, ndigit, + call ivout (logfil, 1, [nev], ndigit, & '_saup2: The length of the current Lanczos factorization') - call ivout (logfil, 1, np, ndigit, + call ivout (logfil, 1, [np], ndigit, & '_saup2: Extend the Lanczos factorization by') end if c @@ -446,7 +446,7 @@ update = .false. c if (msglvl .gt. 1) then - call svout (logfil, 1, rnorm, ndigit, + call svout (logfil, 1, [rnorm], ndigit, & '_saup2: Current B-norm of residual for factorization') end if c @@ -694,7 +694,7 @@ end if c if (msglvl .gt. 0) then - call ivout (logfil, 1, nconv, ndigit, + call ivout (logfil, 1, [nconv], ndigit, & '_saup2: no. of "converged" Ritz values at this iter.') if (msglvl .gt. 1) then kp(1) = nev @@ -742,7 +742,7 @@ if (ishift .eq. 0) call scopy (np, workl, 1, ritz, 1) c if (msglvl .gt. 2) then - call ivout (logfil, 1, np, ndigit, + call ivout (logfil, 1, [np], ndigit, & '_saup2: The number of shifts to apply ') call svout (logfil, np, workl, ndigit, & '_saup2: shifts selected') @@ -809,7 +809,7 @@ 130 continue c if (msglvl .gt. 2) then - call svout (logfil, 1, rnorm, ndigit, + call svout (logfil, 1, [rnorm], ndigit, & '_saup2: B-norm of residual for NEV factorization') call svout (logfil, nev, h(1,2), ndigit, & '_saup2: main diagonal of compressed H matrix') diff -Nru arpack-3.7.0/SRC/ssaupd.f arpack-3.8.0/SRC/ssaupd.f --- arpack-3.7.0/SRC/ssaupd.f 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/SRC/ssaupd.f 2020-12-07 10:40:45.000000000 +0000 @@ -628,9 +628,9 @@ if (info .eq. 2) info = 3 c if (msglvl .gt. 0) then - call ivout (logfil, 1, mxiter, ndigit, + call ivout (logfil, 1, [mxiter], ndigit, & '_saupd: number of update iterations taken') - call ivout (logfil, 1, np, ndigit, + call ivout (logfil, 1, [np], ndigit, & '_saupd: number of "converged" Ritz values') call svout (logfil, np, workl(Ritz), ndigit, & '_saupd: final Ritz values') diff -Nru arpack-3.7.0/SRC/sseupd.f arpack-3.8.0/SRC/sseupd.f --- arpack-3.7.0/SRC/sseupd.f 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/SRC/sseupd.f 2020-12-07 10:40:45.000000000 +0000 @@ -513,9 +513,9 @@ c %-----------------------------------------------------------% c if (msglvl .gt. 2) then - call ivout(logfil, 1, numcnv, ndigit, + call ivout(logfil, 1, [numcnv], ndigit, & '_seupd: Number of specified eigenvalues') - call ivout(logfil, 1, nconv, ndigit, + call ivout(logfil, 1, [nconv], ndigit, & '_seupd: Number of "converged" eigenvalues') end if c diff -Nru arpack-3.7.0/SRC/ssgets.f arpack-3.8.0/SRC/ssgets.f --- arpack-3.7.0/SRC/ssgets.f 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/SRC/ssgets.f 2020-12-07 10:40:45.000000000 +0000 @@ -202,8 +202,8 @@ tsgets = tsgets + (t1 - t0) c if (msglvl .gt. 0) then - call ivout (logfil, 1, kev, ndigit, '_sgets: KEV is') - call ivout (logfil, 1, np, ndigit, '_sgets: NP is') + call ivout (logfil, 1, [kev], ndigit, '_sgets: KEV is') + call ivout (logfil, 1, [np], ndigit, '_sgets: NP is') call svout (logfil, kev+np, ritz, ndigit, & '_sgets: Eigenvalues of current H matrix') call svout (logfil, kev+np, bounds, ndigit, diff -Nru arpack-3.7.0/SRC/zgetv0.f arpack-3.8.0/SRC/zgetv0.f --- arpack-3.7.0/SRC/zgetv0.f 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/SRC/zgetv0.f 2020-12-07 10:40:45.000000000 +0000 @@ -361,9 +361,9 @@ c %--------------------------------------% c if (msglvl .gt. 2) then - call dvout (logfil, 1, rnorm0, ndigit, + call dvout (logfil, 1, [rnorm0], ndigit, & '_getv0: re-orthonalization ; rnorm0 is') - call dvout (logfil, 1, rnorm, ndigit, + call dvout (logfil, 1, [rnorm], ndigit, & '_getv0: re-orthonalization ; rnorm is') end if c @@ -394,7 +394,7 @@ 50 continue c if (msglvl .gt. 0) then - call dvout (logfil, 1, rnorm, ndigit, + call dvout (logfil, 1, [rnorm], ndigit, & '_getv0: B-norm of initial / restarted starting vector') end if if (msglvl .gt. 2) then diff -Nru arpack-3.7.0/SRC/znaitr.f arpack-3.8.0/SRC/znaitr.f --- arpack-3.7.0/SRC/znaitr.f 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/SRC/znaitr.f 2020-12-07 10:40:45.000000000 +0000 @@ -378,9 +378,9 @@ 1000 continue c if (msglvl .gt. 1) then - call ivout (logfil, 1, j, ndigit, + call ivout (logfil, 1, [j], ndigit, & '_naitr: generating Arnoldi vector number') - call dvout (logfil, 1, rnorm, ndigit, + call dvout (logfil, 1, [rnorm], ndigit, & '_naitr: B-norm of the current residual is') end if c @@ -400,7 +400,7 @@ c %---------------------------------------------------% c if (msglvl .gt. 0) then - call ivout (logfil, 1, j, ndigit, + call ivout (logfil, 1, [j], ndigit, & '_naitr: ****** RESTART AT STEP ******') end if c @@ -729,7 +729,7 @@ end if c if (msglvl .gt. 0 .and. iter .gt. 0 ) then - call ivout (logfil, 1, j, ndigit, + call ivout (logfil, 1, [j], ndigit, & '_naitr: Iterative refinement for Arnoldi residual') if (msglvl .gt. 2) then rtemp(1) = rnorm diff -Nru arpack-3.7.0/SRC/znapps.f arpack-3.8.0/SRC/znapps.f --- arpack-3.7.0/SRC/znapps.f 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/SRC/znapps.f 2020-12-07 10:40:45.000000000 +0000 @@ -268,9 +268,9 @@ sigma = shift(jj) c if (msglvl .gt. 2 ) then - call ivout (logfil, 1, jj, ndigit, + call ivout (logfil, 1, [jj], ndigit, & '_napps: shift number.') - call zvout (logfil, 1, sigma, ndigit, + call zvout (logfil, 1, [sigma], ndigit, & '_napps: Value of the shift ') end if c @@ -291,9 +291,9 @@ if ( abs(dble(h(i+1,i))) & .le. max(ulp*tst1, smlnum) ) then if (msglvl .gt. 0) then - call ivout (logfil, 1, i, ndigit, + call ivout (logfil, 1, [i], ndigit, & '_napps: matrix splitting at row/column no.') - call ivout (logfil, 1, jj, ndigit, + call ivout (logfil, 1, [jj], ndigit, & '_napps: matrix splitting with shift number.') call zvout (logfil, 1, h(i+1,i), ndigit, & '_napps: off diagonal element.') @@ -307,9 +307,9 @@ 40 continue c if (msglvl .gt. 2) then - call ivout (logfil, 1, istart, ndigit, + call ivout (logfil, 1, [istart], ndigit, & '_napps: Start of current block ') - call ivout (logfil, 1, iend, ndigit, + call ivout (logfil, 1, [iend], ndigit, & '_napps: End of current block ') end if c @@ -485,7 +485,7 @@ & '_napps: sigmak = (e_{kev+p}^T*Q)*e_{kev}') call zvout (logfil, 1, h(kev+1,kev), ndigit, & '_napps: betak = e_{kev+1}^T*H*e_{kev}') - call ivout (logfil, 1, kev, ndigit, + call ivout (logfil, 1, [kev], ndigit, & '_napps: Order of the final Hessenberg matrix ') if (msglvl .gt. 2) then call zmout (logfil, kev, kev, h, ldh, ndigit, diff -Nru arpack-3.7.0/SRC/znaup2.f arpack-3.8.0/SRC/znaup2.f --- arpack-3.7.0/SRC/znaup2.f 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/SRC/znaup2.f 2020-12-07 10:40:45.000000000 +0000 @@ -389,7 +389,7 @@ iter = iter + 1 c if (msglvl .gt. 0) then - call ivout (logfil, 1, iter, ndigit, + call ivout (logfil, 1, [iter], ndigit, & '_naup2: **** Start of major iteration number ****') end if c @@ -402,9 +402,9 @@ np = kplusp - nev c if (msglvl .gt. 1) then - call ivout (logfil, 1, nev, ndigit, + call ivout (logfil, 1, [nev], ndigit, & '_naup2: The length of the current Arnoldi factorization') - call ivout (logfil, 1, np, ndigit, + call ivout (logfil, 1, [np], ndigit, & '_naup2: Extend the Arnoldi factorization by') end if c @@ -430,7 +430,7 @@ update = .false. c if (msglvl .gt. 1) then - call dvout (logfil, 1, rnorm, ndigit, + call dvout (logfil, 1, [rnorm], ndigit, & '_naup2: Corresponding B-norm of the residual') end if c @@ -658,7 +658,7 @@ end if c if (msglvl .gt. 0) then - call ivout (logfil, 1, nconv, ndigit, + call ivout (logfil, 1, [nconv], ndigit, & '_naup2: no. of "converged" Ritz values at this iter.') if (msglvl .gt. 1) then kp(1) = nev @@ -698,7 +698,7 @@ end if c if (msglvl .gt. 2) then - call ivout (logfil, 1, np, ndigit, + call ivout (logfil, 1, [np], ndigit, & '_naup2: The number of shifts to apply ') call zvout (logfil, np, ritz, ndigit, & '_naup2: values of the shifts') @@ -762,7 +762,7 @@ cnorm = .false. c if (msglvl .gt. 2) then - call dvout (logfil, 1, rnorm, ndigit, + call dvout (logfil, 1, [rnorm], ndigit, & '_naup2: B-norm of residual for compressed factorization') call zmout (logfil, nev, nev, h, ldh, ndigit, & '_naup2: Compressed upper Hessenberg matrix H') diff -Nru arpack-3.7.0/SRC/znaupd.f arpack-3.8.0/SRC/znaupd.f --- arpack-3.7.0/SRC/znaupd.f 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/SRC/znaupd.f 2020-12-07 10:40:45.000000000 +0000 @@ -601,9 +601,9 @@ if (info .eq. 2) info = 3 c if (msglvl .gt. 0) then - call ivout (logfil, 1, mxiter, ndigit, + call ivout (logfil, 1, [mxiter], ndigit, & '_naupd: Number of update iterations taken') - call ivout (logfil, 1, np, ndigit, + call ivout (logfil, 1, [np], ndigit, & '_naupd: Number of wanted "converged" Ritz values') call zvout (logfil, np, workl(ritz), ndigit, & '_naupd: The final Ritz values') diff -Nru arpack-3.7.0/SRC/zneupd.f arpack-3.8.0/SRC/zneupd.f --- arpack-3.7.0/SRC/zneupd.f 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/SRC/zneupd.f 2020-12-07 10:40:45.000000000 +0000 @@ -536,9 +536,9 @@ c %-----------------------------------------------------------% c if (msglvl .gt. 2) then - call ivout(logfil, 1, numcnv, ndigit, + call ivout(logfil, 1, [numcnv], ndigit, & '_neupd: Number of specified eigenvalues') - call ivout(logfil, 1, nconv, ndigit, + call ivout(logfil, 1, [nconv], ndigit, & '_neupd: Number of "converged" eigenvalues') end if c diff -Nru arpack-3.7.0/SRC/zngets.f arpack-3.8.0/SRC/zngets.f --- arpack-3.7.0/SRC/zngets.f 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/SRC/zngets.f 2020-12-07 10:40:45.000000000 +0000 @@ -161,8 +161,8 @@ tcgets = tcgets + (t1 - t0) c if (msglvl .gt. 0) then - call ivout (logfil, 1, kev, ndigit, '_ngets: KEV is') - call ivout (logfil, 1, np, ndigit, '_ngets: NP is') + call ivout (logfil, 1, [kev], ndigit, '_ngets: KEV is') + call ivout (logfil, 1, [np], ndigit, '_ngets: NP is') call zvout (logfil, kev+np, ritz, ndigit, & '_ngets: Eigenvalues of current H matrix ') call zvout (logfil, kev+np, bounds, ndigit, diff -Nru arpack-3.7.0/TESTS/bug_1315_double.c arpack-3.8.0/TESTS/bug_1315_double.c --- arpack-3.7.0/TESTS/bug_1315_double.c 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/TESTS/bug_1315_double.c 2020-12-07 10:40:45.000000000 +0000 @@ -1,8 +1,8 @@ -#include "arpackdef.h" - +#include #include #include -#include + +#include "arpackdef.h" // This test calls fortran from C the old-fashion cumbersome way. // Note: icb_arpack_c tests the same kind of things using ICB. @@ -19,19 +19,19 @@ * symmetric but is done to exhibit the bug. * */ -extern void dnaupd(a_int *, char *, a_int *, char *, a_int *, - double *, double *, a_int *, double *, - a_int *, a_int *, a_int *, double *, - double *, a_int *, a_int *); - -extern void dneupd( a_int*, char*, a_int *, double *, double *, double *, a_int*, double *, - double *, double *, char *, a_int *, char *, a_int *, double *, double *, a_int *, - double *, a_int *, a_int *, a_int *, double *, double *, a_int *, a_int * ); +extern void dnaupd(a_int *, char *, a_int *, char *, a_int *, double *, + double *, a_int *, double *, a_int *, a_int *, a_int *, + double *, double *, a_int *, a_int *); + +extern void dneupd(a_int *, char *, a_int *, double *, double *, double *, + a_int *, double *, double *, double *, char *, a_int *, + char *, a_int *, double *, double *, a_int *, double *, + a_int *, a_int *, a_int *, double *, double *, a_int *, + a_int *); -void matVec(double * x, double * y) { +void matVec(double *x, double *y) { int i; - for ( i = 0; i < 1000; ++i) - y[i] = ((double) (i+1))*x[i]; + for (i = 0; i < 1000; ++i) y[i] = ((double)(i + 1)) * x[i]; }; int main() { @@ -42,54 +42,51 @@ a_int nev = 9; double tol = 0; double resid[N]; - a_int ncv = 2*nev+1; - double V[ncv*N]; + a_int ncv = 2 * nev + 1; + double V[ncv * N]; a_int ldv = N; a_int iparam[11]; a_int ipntr[14]; - double workd[3*N]; + double workd[3 * N]; a_int rvec = 1; char howmny[] = "A"; - double* dr = (double*) malloc((nev+1)*sizeof(double)); - double* di = (double*) malloc((nev+1)*sizeof(double)); - a_int select[3*ncv]; - double z[(N+1)*(nev+1)]; - a_int ldz = N+1; - double sigmar=0; - double sigmai=0; - double workev[3*ncv]; + double *dr = (double *)malloc((nev + 1) * sizeof(double)); + double *di = (double *)malloc((nev + 1) * sizeof(double)); + a_int select[3 * ncv]; + double z[(N + 1) * (nev + 1)]; + a_int ldz = N + 1; + double sigmar = 0; + double sigmai = 0; + double workev[3 * ncv]; int k; - for (k=0; k < 3*N; ++k ) - workd[k] = 0; - double workl[3*(ncv*ncv) + 6*ncv]; - for (k=0; k < 3*(ncv*ncv) + 6*ncv; ++k ) - workl[k] = 0; - a_int lworkl = 3*(ncv*ncv) + 6*ncv; + for (k = 0; k < 3 * N; ++k) workd[k] = 0; + double workl[3 * (ncv * ncv) + 6 * ncv]; + for (k = 0; k < 3 * (ncv * ncv) + 6 * ncv; ++k) workl[k] = 0; + a_int lworkl = 3 * (ncv * ncv) + 6 * ncv; a_int info = 0; iparam[0] = 1; - iparam[2] = 10*N; + iparam[2] = 10 * N; iparam[3] = 1; iparam[6] = 1; dnaupd(&ido, bmat, &N, which, &nev, &tol, resid, &ncv, V, &ldv, iparam, ipntr, - workd, workl, &lworkl, &info); - - while(ido == -1 || ido == 1) { + workd, workl, &lworkl, &info); - matVec(&(workd[ipntr[0]-1]), &(workd[ipntr[1]-1])); + while (ido == -1 || ido == 1) { + matVec(&(workd[ipntr[0] - 1]), &(workd[ipntr[1] - 1])); - dnaupd(&ido, bmat, &N, which, &nev, &tol, resid, &ncv, V, &ldv, iparam, ipntr, - workd, workl, &lworkl, &info); + dnaupd(&ido, bmat, &N, which, &nev, &tol, resid, &ncv, V, &ldv, iparam, + ipntr, workd, workl, &lworkl, &info); } - dneupd( &rvec, howmny, select, dr,di, z, &ldz, &sigmar, &sigmai,workev, - bmat, &N, which, &nev, &tol, resid, &ncv, V, &ldv, iparam, ipntr, - workd, workl, &lworkl, &info); + dneupd(&rvec, howmny, select, dr, di, z, &ldz, &sigmar, &sigmai, workev, bmat, + &N, which, &nev, &tol, resid, &ncv, V, &ldv, iparam, ipntr, workd, + workl, &lworkl, &info); int i; for (i = 0; i < nev; ++i) { printf("%f\n", dr[i]); - if(fabs(dr[i] - (double)(1000-i))>1e-6){ + if (fabs(dr[i] - (double)(1000 - i)) > 1e-6) { free(dr); free(di); exit(EXIT_FAILURE); diff -Nru arpack-3.7.0/TESTS/bug_1315_single.c arpack-3.8.0/TESTS/bug_1315_single.c --- arpack-3.7.0/TESTS/bug_1315_single.c 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/TESTS/bug_1315_single.c 2020-12-07 10:40:45.000000000 +0000 @@ -1,8 +1,8 @@ -#include "arpackdef.h" - +#include #include #include -#include + +#include "arpackdef.h" // This test calls fortran from C the old-fashion cumbersome way. // Note: icb_arpack_c tests the same kind of things using ICB. @@ -19,20 +19,18 @@ * symmetric but is done to exhibit the bug. */ -extern void snaupd(a_int *, char *, a_int *, char *, a_int *, - float *, float *, a_int *, float *, - a_int *, a_int *, a_int *, float *, - float *, a_int *, a_int *); - -extern void sneupd( a_int*, char*, a_int *, float *, float *, float *, a_int*, float *, - float *, float *, char *, a_int *, char *, a_int *, float *, float *, a_int *, - float *, a_int *, a_int *, a_int *, float *, float *, a_int *, a_int * ); +extern void snaupd(a_int *, char *, a_int *, char *, a_int *, float *, float *, + a_int *, float *, a_int *, a_int *, a_int *, float *, + float *, a_int *, a_int *); + +extern void sneupd(a_int *, char *, a_int *, float *, float *, float *, a_int *, + float *, float *, float *, char *, a_int *, char *, a_int *, + float *, float *, a_int *, float *, a_int *, a_int *, + a_int *, float *, float *, a_int *, a_int *); - -void matVec(float * x, float * y) { +void matVec(float *x, float *y) { int i; - for ( i = 0; i < 1000; ++i) - y[i] = ((float) (i+1))*x[i]; + for (i = 0; i < 1000; ++i) y[i] = ((float)(i + 1)) * x[i]; }; int main() { @@ -43,54 +41,51 @@ a_int nev = 9; float tol = 0; float resid[N]; - a_int ncv = 2*nev+1; - float V[ncv*N]; + a_int ncv = 2 * nev + 1; + float V[ncv * N]; a_int ldv = N; a_int iparam[11]; a_int ipntr[14]; - float workd[3*N]; + float workd[3 * N]; a_int rvec = 1; char howmny[] = "A"; - float* dr = (float*) malloc((nev+1)*sizeof(float)); - float* di = (float*) malloc((nev+1)*sizeof(float)); - a_int select[3*ncv]; - float z[(N+1)*(nev+1)]; - a_int ldz = N+1; - float sigmar=0; - float sigmai=0; - float workev[3*ncv]; + float *dr = (float *)malloc((nev + 1) * sizeof(float)); + float *di = (float *)malloc((nev + 1) * sizeof(float)); + a_int select[3 * ncv]; + float z[(N + 1) * (nev + 1)]; + a_int ldz = N + 1; + float sigmar = 0; + float sigmai = 0; + float workev[3 * ncv]; int k; - for (k=0; k < 3*N; ++k ) - workd[k] = 0; - float workl[3*(ncv*ncv) + 6*ncv]; - for (k=0; k < 3*(ncv*ncv) + 6*ncv; ++k ) - workl[k] = 0; - a_int lworkl = 3*(ncv*ncv) + 6*ncv; + for (k = 0; k < 3 * N; ++k) workd[k] = 0; + float workl[3 * (ncv * ncv) + 6 * ncv]; + for (k = 0; k < 3 * (ncv * ncv) + 6 * ncv; ++k) workl[k] = 0; + a_int lworkl = 3 * (ncv * ncv) + 6 * ncv; a_int info = 0; iparam[0] = 1; - iparam[2] = 10*N; + iparam[2] = 10 * N; iparam[3] = 1; iparam[6] = 1; snaupd(&ido, bmat, &N, which, &nev, &tol, resid, &ncv, V, &ldv, iparam, ipntr, - workd, workl, &lworkl, &info); - - while(ido == -1 || ido == 1) { + workd, workl, &lworkl, &info); - matVec(&(workd[ipntr[0]-1]), &(workd[ipntr[1]-1])); + while (ido == -1 || ido == 1) { + matVec(&(workd[ipntr[0] - 1]), &(workd[ipntr[1] - 1])); - snaupd(&ido, bmat, &N, which, &nev, &tol, resid, &ncv, V, &ldv, iparam, ipntr, - workd, workl, &lworkl, &info); + snaupd(&ido, bmat, &N, which, &nev, &tol, resid, &ncv, V, &ldv, iparam, + ipntr, workd, workl, &lworkl, &info); } - sneupd( &rvec, howmny, select, dr,di, z, &ldz, &sigmar, &sigmai,workev, - bmat, &N, which, &nev, &tol, resid, &ncv, V, &ldv, iparam, ipntr, - workd, workl, &lworkl, &info); + sneupd(&rvec, howmny, select, dr, di, z, &ldz, &sigmar, &sigmai, workev, bmat, + &N, which, &nev, &tol, resid, &ncv, V, &ldv, iparam, ipntr, workd, + workl, &lworkl, &info); int i; for (i = 0; i < nev; ++i) { printf("%f\n", dr[i]); - if(fabs(dr[i] - (float)(1000-i))>1e-2){ + if (fabs(dr[i] - (float)(1000 - i)) > 1e-2) { free(dr); free(di); exit(EXIT_FAILURE); diff -Nru arpack-3.7.0/TESTS/bug_79_double_complex.f arpack-3.8.0/TESTS/bug_79_double_complex.f --- arpack-3.7.0/TESTS/bug_79_double_complex.f 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/TESTS/bug_79_double_complex.f 2020-12-07 10:40:45.000000000 +0000 @@ -217,7 +217,12 @@ go to 9000 end if 9000 continue - if (res1 .ne. res2) then +c Compare difference to double precision 0 instead of using +c bitwise comparison operator .ne. + if (abs(res1 - res2) > 0.0D+0) then + write(6,'(a,e24.16,a,e24.16,a,e24.16)') + & "ERROR res1 (", res1, " ) not equal to res2 (", res2, + & " ); difference = ", res1 - res2 stop 1 end if end diff -Nru arpack-3.7.0/TESTS/icb_arpack_c.c arpack-3.8.0/TESTS/icb_arpack_c.c --- arpack-3.7.0/TESTS/icb_arpack_c.c 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/TESTS/icb_arpack_c.c 2020-12-07 10:40:45.000000000 +0000 @@ -1,29 +1,29 @@ /* - * This example demonstrates the use of ISO_C_BINDING to call arpack (portability). + * This example demonstrates the use of ISO_C_BINDING to call arpack + * (portability). * - * Just use arpack as you would have normally done, but, use *[ae]upd_c instead of *[ae]upd_. - * The main advantage is that compiler checks (arguments) are performed at build time. - * Note: to debug arpack, call debug_c. + * Just use arpack as you would have normally done, but, use *[ae]upd_c instead + * of *[ae]upd_. The main advantage is that compiler checks (arguments) are + * performed at build time. Note: to debug arpack, call debug_c. */ +#include // creal, cimag. +#include #include #include -#include -#include // bool. + #include "arpack.h" -#include // creal, cimag. -#include "debug_c.h" // debug arpack. -#include "stat_c.h" // arpack statistics. +#include "debug_c.h" // debug arpack. +#include "stat_c.h" // arpack statistics. /* test program to solve for the 9 largest eigenvalues of * A*x = lambda*x where A is the diagonal matrix * with entries 1000, 999, ... , 2, 1 on the diagonal. * */ -void dMatVec(double * x, double * y) { +void dMatVec(double* x, double* y) { int i; - for ( i = 0; i < 1000; ++i) - y[i] = ((double) (i+1))*x[i]; + for (i = 0; i < 1000; ++i) y[i] = ((double)(i + 1)) * x[i]; }; int ds() { @@ -32,53 +32,56 @@ a_int N = 1000; char which[] = "LM"; a_int nev = 9; - double tol = 0; + double tol = 0.000001; // small tol => more stable checks after EV computation. double resid[N]; - a_int ncv = 2*nev+1; - double V[ncv*N]; + a_int ncv = 2 * nev + 1; + double V[ncv * N]; a_int ldv = N; a_int iparam[11]; a_int ipntr[14]; - double workd[3*N]; - bool rvec = true; + double workd[3 * N]; + a_int rvec = 1; char howmny[] = "A"; - double* d = (double*) malloc((nev+1)*sizeof(double)); + double* d = (double*)malloc((nev + 1) * sizeof(double)); a_int select[ncv]; - double z[(N+1)*(nev+1)]; - a_int ldz = N+1; - double sigma=0; + for (int i = 0; i < ncv; i++) select[i] = 1; + double z[(N + 1) * (nev + 1)]; + a_int ldz = N + 1; + double sigma = 0; int k; - for (k=0; k < 3*N; ++k ) - workd[k] = 0; - double workl[3*(ncv*ncv) + 6*ncv]; - for (k=0; k < 3*(ncv*ncv) + 6*ncv; ++k ) - workl[k] = 0; - a_int lworkl = 3*(ncv*ncv) + 6*ncv; + for (k = 0; k < 3 * N; ++k) workd[k] = 0; + double workl[3 * (ncv * ncv) + 6 * ncv]; + for (k = 0; k < 3 * (ncv * ncv) + 6 * ncv; ++k) workl[k] = 0; + a_int lworkl = 3 * (ncv * ncv) + 6 * ncv; a_int info = 0; iparam[0] = 1; - iparam[2] = 10*N; + iparam[2] = 10 * N; iparam[3] = 1; - iparam[4] = 0; // number of ev found by arpack. + iparam[4] = 0; // number of ev found by arpack. iparam[6] = 1; - while(ido != 99) { + while (ido != 99) { /* call arpack like you would have, but, use dsaupd_c instead of dsaupd_ */ dsaupd_c(&ido, bmat, N, which, nev, tol, resid, ncv, V, ldv, iparam, ipntr, workd, workl, lworkl, &info); - dMatVec(&(workd[ipntr[0]-1]), &(workd[ipntr[1]-1])); + dMatVec(&(workd[ipntr[0] - 1]), &(workd[ipntr[1] - 1])); } - if (iparam[4] != nev) return 1; // check number of ev found by arpack. + if (iparam[4] != nev) {printf("Error: iparam[4] %d, nev %d\n", iparam[4], nev); return 1;} // check number of ev found by arpack. /* call arpack like you would have, but, use dseupd_c instead of dseupd_ */ - dseupd_c(rvec, howmny, select, d, z, ldz, sigma, - bmat, N, which, nev, tol, resid, ncv, V, ldv, iparam, ipntr, - workd, workl, lworkl, &info); + dseupd_c(rvec, howmny, select, d, z, ldz, sigma, bmat, N, which, nev, tol, + resid, ncv, V, ldv, iparam, ipntr, workd, workl, lworkl, &info); int i; for (i = 0; i < nev; ++i) { - printf("%f\n", d[i]); - if(fabs(d[i] - (double)(1000-(nev-1)+i))>1e-6){ + double val = d[i]; + double ref = (N-(nev-1)+i); + double eps = fabs(val - ref); + printf("%f - %f - %f\n", val, ref, eps); + + /*eigen value order: smallest -> biggest*/ + if(eps>1.e-05){ free(d); return 1; } @@ -87,10 +90,9 @@ return 0; } -void zMatVec(double _Complex * x, double _Complex * y) { +void zMatVec(double _Complex* x, double _Complex* y) { int i; - for (i = 0; i < 1000; ++i) - y[i] = x[i] * (i+1.0 + _Complex_I * (i+1.0)); + for (i = 0; i < 1000; ++i) y[i] = x[i] * (i + 1.0 + _Complex_I * (i + 1.0)); }; int zn() { @@ -99,55 +101,63 @@ a_int N = 1000; char which[] = "LM"; a_int nev = 9; - double tol = 0; + double tol = 0.000001; // small tol => more stable checks after EV computation. double _Complex resid[N]; - a_int ncv = 2*nev+1; - double _Complex V[ncv*N]; + a_int ncv = 2 * nev + 1; + double _Complex V[ncv * N]; a_int ldv = N; a_int iparam[11]; a_int ipntr[14]; - double _Complex workd[3*N]; - bool rvec = true; + double _Complex workd[3 * N]; + a_int rvec = 0; char howmny[] = "A"; - double _Complex* d = (double _Complex*) malloc((nev+1)*sizeof(double _Complex)); + double _Complex* d = + (double _Complex*)malloc((nev + 1) * sizeof(double _Complex)); a_int select[ncv]; - double _Complex z[(N+1)*(nev+1)]; - a_int ldz = N+1; - double _Complex sigma=0. + I*0.; + for (int i = 0; i < ncv; i++) select[i] = 1; + double _Complex z[(N + 1) * (nev + 1)]; + a_int ldz = N + 1; + double _Complex sigma = 0. + I * 0.; int k; - for (k=0; k < 3*N; ++k ) - workd[k] = 0; - double _Complex workl[3*(ncv*ncv) + 6*ncv]; - for (k=0; k < 3*(ncv*ncv) + 6*ncv; ++k ) - workl[k] = 0; - a_int lworkl = 3*(ncv*ncv) + 6*ncv; + for (k = 0; k < 3 * N; ++k) workd[k] = 0; + double _Complex workl[3 * (ncv * ncv) + 6 * ncv]; + for (k = 0; k < 3 * (ncv * ncv) + 6 * ncv; ++k) workl[k] = 0; + a_int lworkl = 3 * (ncv * ncv) + 6 * ncv; double rwork[ncv]; - double _Complex workev[2*ncv]; + double _Complex workev[2 * ncv]; a_int info = 0; iparam[0] = 1; - iparam[2] = 10*N; + iparam[2] = 10 * N; iparam[3] = 1; - iparam[4] = 0; // number of ev found by arpack. + iparam[4] = 0; // number of ev found by arpack. iparam[6] = 1; - while(ido != 99) { + while (ido != 99) { /* call arpack like you would have, but, use znaupd_c instead of znaupd_ */ znaupd_c(&ido, bmat, N, which, nev, tol, resid, ncv, V, ldv, iparam, ipntr, workd, workl, lworkl, rwork, &info); - zMatVec(&(workd[ipntr[0]-1]), &(workd[ipntr[1]-1])); + zMatVec(&(workd[ipntr[0] - 1]), &(workd[ipntr[1] - 1])); } - if (iparam[4] != nev) return 1; // check number of ev found by arpack. + if (iparam[4] != nev) {printf("Error: iparam[4] %d, nev %d\n", iparam[4], nev); return 1;} // check number of ev found by arpack. /* call arpack like you would have, but, use zneupd_c instead of zneupd_ */ - zneupd_c(rvec, howmny, select, d, z, ldz, sigma, workev, - bmat, N, which, nev, tol, resid, ncv, V, ldv, iparam, ipntr, - workd, workl, lworkl, rwork, &info); + zneupd_c(rvec, howmny, select, d, z, ldz, sigma, workev, bmat, N, which, nev, + tol, resid, ncv, V, ldv, iparam, ipntr, workd, workl, lworkl, rwork, + &info); int i; for (i = 0; i < nev; ++i) { - printf("%f %f\n", creal(d[i]), cimag(d[i])); - if(fabs(creal(d[i]) - (double)(1000-i))>1e-6 || fabs(cimag(d[i]) - (double)(1000-i))>1e-6){ + double rval = creal(d[i]); + double rref = (N-(nev-1)+i); + double reps = fabs(rval - rref); + double ival = cimag(d[i]); + double iref = (N-(nev-1)+i); + double ieps = fabs(ival - iref); + printf("%f %f - %f %f - %f %f\n", rval, ival, rref, iref, reps, ieps); + + /*eigen value order: smallest -> biggest*/ + if(reps>1.e-05 || ieps>1.e-05){ free(d); return 1; } @@ -158,27 +168,30 @@ int main() { sstats_c(); - int rc = ds(); // arpack without debug. + int rc = ds(); // arpack without debug. if (rc != 0) return rc; - int nopx_c, nbx_c, nrorth_c, nitref_c, nrstrt_c; + a_int nopx_c, nbx_c, nrorth_c, nitref_c, nrstrt_c; float tsaupd_c, tsaup2_c, tsaitr_c, tseigt_c, tsgets_c, tsapps_c, tsconv_c; float tnaupd_c, tnaup2_c, tnaitr_c, tneigt_c, tngets_c, tnapps_c, tnconv_c; float tcaupd_c, tcaup2_c, tcaitr_c, tceigt_c, tcgets_c, tcapps_c, tcconv_c; float tmvopx_c, tmvbx_c, tgetv0_c, titref_c, trvec_c; - stat_c( &nopx_c, &nbx_c, &nrorth_c, &nitref_c, &nrstrt_c, - &tsaupd_c, &tsaup2_c, &tsaitr_c, &tseigt_c, &tsgets_c, &tsapps_c, &tsconv_c, - &tnaupd_c, &tnaup2_c, &tnaitr_c, &tneigt_c, &tngets_c, &tnapps_c, &tnconv_c, - &tcaupd_c, &tcaup2_c, &tcaitr_c, &tceigt_c, &tcgets_c, &tcapps_c, &tcconv_c, - &tmvopx_c, &tmvbx_c, &tgetv0_c, &titref_c, &trvec_c); - printf("Timers : nopx %d, tmvopx %f - nbx %d, tmvbx %f\n", nopx_c, tmvopx_c, nbx_c, tmvbx_c); + stat_c(&nopx_c, &nbx_c, &nrorth_c, &nitref_c, &nrstrt_c, &tsaupd_c, &tsaup2_c, + &tsaitr_c, &tseigt_c, &tsgets_c, &tsapps_c, &tsconv_c, &tnaupd_c, + &tnaup2_c, &tnaitr_c, &tneigt_c, &tngets_c, &tnapps_c, &tnconv_c, + &tcaupd_c, &tcaup2_c, &tcaitr_c, &tceigt_c, &tcgets_c, &tcapps_c, + &tcconv_c, &tmvopx_c, &tmvbx_c, &tgetv0_c, &titref_c, &trvec_c); + printf("Timers : nopx %d, tmvopx %f - nbx %d, tmvbx %f\n", nopx_c, tmvopx_c, + nbx_c, tmvbx_c); printf("------\n"); + // clang-format off debug_c(6, -6, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1); // set debug flags. - rc = zn(); // arpack with debug. + // clang-format on + rc = zn(); // arpack with debug. return rc; } diff -Nru arpack-3.7.0/TESTS/icb_arpack_cpp.cpp arpack-3.8.0/TESTS/icb_arpack_cpp.cpp --- arpack-3.7.0/TESTS/icb_arpack_cpp.cpp 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/TESTS/icb_arpack_cpp.cpp 2020-12-07 10:40:45.000000000 +0000 @@ -9,25 +9,24 @@ * matrix with entries 1000, 999, ... , 2, 1 on the diagonal. */ -#include "arpack.hpp" - #include #include #include #include +#include "arpack.hpp" #include "debug_c.hpp" // debug arpack. #include "stat_c.hpp" // arpack statistics. -template +template void diagonal_matrix_vector_product(Real const* const x, Real* const y) { for (int i = 0; i < 1000; ++i) { y[i] = static_cast(i + 1) * x[i]; } } -template -void real_symmetric_runner() { +template +void real_symmetric_runner(double const& tol_check) { a_int const N = 1000; a_int const nev = 9; @@ -38,10 +37,10 @@ a_int const lworkl = 3 * (ncv * ncv) + 6 * ncv; - Real const tol = 0.0; + Real const tol = 0.000001; // small tol => more stable checks after EV computation. Real const sigma = 0.0; - bool const rvec = true; + a_int const rvec = 1; std::vector resid(N); std::vector V(ncv * N); @@ -73,11 +72,14 @@ } // check number of ev found by arpack. - if (iparam[4] != nev || info != 0) { + if (iparam[4] < nev) { /*arpack may succeed to compute more EV than expected*/ + std::cout << "ERROR: iparam[4] " << iparam[4] << ", nev " << nev + << ", info " << info << std::endl; throw std::domain_error("Error inside ARPACK routines"); } std::vector select(ncv); + for (int i = 0; i < ncv; i++) select[i] = 1; arpack::seupd(rvec, arpack::howmny::ritz_vectors, select.data(), d.data(), z.data(), ldz, sigma, arpack::bmat::identity, N, @@ -86,16 +88,20 @@ workl.data(), lworkl, info); for (int i = 0; i < nev; ++i) { - std::cout << d[i] << "\n"; + Real val = d[i]; + Real ref = static_cast(N - (nev - 1) + i); + Real eps = std::fabs(val - ref); + std::cout << val << " - " << ref << " - " << eps << std::endl; - if (std::abs(d[i] - static_cast(1000 - (nev - 1) + i)) > 1e-1) { + /*eigen value order: smallest -> biggest*/ + if (eps > tol_check) { throw std::domain_error("Correct eigenvalues not computed"); } } std::cout << "------\n"; } -template +template void diagonal_matrix_vector_product(std::complex const* const x, std::complex* const y) { for (int i = 0; i < 1000; ++i) { @@ -103,8 +109,8 @@ } } -template -void complex_symmetric_runner() { +template +void complex_symmetric_runner(double const& tol_check) { a_int const N = 1000; a_int const nev = 9; @@ -115,10 +121,10 @@ a_int const lworkl = 3 * (ncv * ncv) + 6 * ncv; - Real const tol = 0.0; + Real const tol = 0.000001; // small tol => more stable checks after EV computation. std::complex const sigma(0.0, 0.0); - bool const rvec = true; + a_int const rvec = 0; std::vector> resid(N); std::vector> V(ncv * N); @@ -151,11 +157,14 @@ } // check number of ev found by arpack. - if (iparam[4] != nev || info != 0) { + if (iparam[4] < nev) { /*arpack may succeed to compute more EV than expected*/ + std::cout << "ERROR: iparam[4] " << iparam[4] << ", nev " << nev + << ", info " << info << std::endl; throw std::domain_error("Error inside ARPACK routines"); } std::vector select(ncv); + for (int i = 0; i < ncv; i++) select[i] = 1; arpack::neupd(rvec, arpack::howmny::ritz_vectors, select.data(), d.data(), z.data(), ldz, sigma, workev.data(), arpack::bmat::identity, N, @@ -164,10 +173,16 @@ workl.data(), lworkl, rwork.data(), info); for (int i = 0; i < nev; ++i) { - std::cout << d[i] << "\n"; + Real rval = std::real(d[i]); + Real rref = static_cast(N - (nev - 1) + i); + Real reps = std::fabs(rval - rref); + Real ival = std::imag(d[i]); + Real iref = static_cast(N - (nev - 1) + i); + Real ieps = std::fabs(ival - iref); + std::cout << rval << " " << ival << " - " << rref << " " << iref << " - " << reps << " " << ieps << std::endl; - if (std::abs(std::real(d[i]) - static_cast(1000 - i)) > 1e-1 || - std::abs(std::imag(d[i]) - static_cast(1000 - i)) > 1e-1) { + /*eigen value order: smallest -> biggest*/ + if (reps > tol_check || ieps > tol_check) { throw std::domain_error("Correct eigenvalues not computed"); } } @@ -177,10 +192,10 @@ sstats_c(); // arpack without debug - real_symmetric_runner(); - real_symmetric_runner(); + real_symmetric_runner(1.); + real_symmetric_runner(1.e-05); - int nopx_c, nbx_c, nrorth_c, nitref_c, nrstrt_c; + a_int nopx_c, nbx_c, nrorth_c, nitref_c, nrstrt_c; float tsaupd_c, tsaup2_c, tsaitr_c, tseigt_c, tsgets_c, tsapps_c, tsconv_c; float tnaupd_c, tnaup2_c, tnaitr_c, tneigt_c, tngets_c, tnapps_c, tnconv_c; float tcaupd_c, tcaup2_c, tcaitr_c, tceigt_c, tcgets_c, tcapps_c, tcconv_c; @@ -200,8 +215,8 @@ 1); // arpack with debug - complex_symmetric_runner(); - complex_symmetric_runner(); + complex_symmetric_runner(1.); + complex_symmetric_runner(1.e-05); return 0; } diff -Nru arpack-3.7.0/.travis.yml arpack-3.8.0/.travis.yml --- arpack-3.7.0/.travis.yml 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/.travis.yml 2020-12-07 10:40:45.000000000 +0000 @@ -16,6 +16,8 @@ - cmake - automake - autoconf + - pkg-config + - libtool - libblas-dev - liblapack-dev - diffutils @@ -27,110 +29,260 @@ stages: # order stages - - name: precise - - name: trusty - - name: xenial + - name: opensuse + - name: centos + - name: fedora + - name: osx + - name: ubuntu_precise + - name: ubuntu_trusty + - name: ubuntu_xenial + - name: ubuntu_bionic + - name: ubuntu_eoan + - name: ubuntu_focal - name: coverage - - name: interface64 + - name: debian_interface64 jobs: include: - # precise <=> test "older" systems, without ICB, without cmake (too old to be supported) - - stage: precise + # opensuse: "recent" systems with ICB + # note: when you PR, docker-cp provides, in the container, the branch associated with the PR (not master where there's nothing new) + # 1. docker create --name mobydick IMAGE CMD <=> create a container (= instance of image) but container is NOT yet started + # 2. docker cp -a ${TRAVIS_BUILD_DIR} mobydick:/tmp <=> copy git repository (CI worker, checkout-ed on PR branch) into the container + # note: docker-cp works only if copy from/to containers (not images) + # 3. docker start -a mobydick <=> start to run the container (initialized with docker-cp) + - stage: opensuse + dist: bionic + script: | + sudo docker pull opensuse/tumbleweed \ + && \ + sudo docker create --name mobydick opensuse/tumbleweed /bin/bash -c \ + "zypper install -y git gcc gcc-fortran gcc-c++ openmpi2-devel && \ + zypper install -y cmake && \ + zypper install -y blas-devel lapack-devel && \ + cd /tmp && \ + cd arpack-ng && \ + git status && \ + git log -2 && \ + sed -e 's/mpirun /mpirun --allow-run-as-root --oversubscribe /' -i CMakeLists.txt && \ + mkdir -p build && cd build && \ + cmake -DEXAMPLES=ON -DMPI=ON -DICB=ON .. && \ + export PATH=/usr/lib64/mpi/gcc/openmpi2/bin:/usr/lib/mpi/gcc/openmpi2/bin/:$PATH && \ + make all && make test" \ + && \ + sudo docker cp -a ${TRAVIS_BUILD_DIR} mobydick:/tmp \ + && \ + sudo docker start -a mobydick + # centos: "recent" systems with ICB + - stage: centos + dist: bionic + script: | + sudo docker pull centos \ + && \ + sudo docker create --name mobydick centos /bin/bash -c \ + "dnf install -y dnf-plugins-core epel-release && \ + dnf upgrade -y && \ + dnf config-manager --set-enabled PowerTools && \ + dnf install -y git make gcc gcc-gfortran gcc-c++ environment-modules && \ + dnf install -y cmake && \ + dnf install -y mpich-devel && \ + dnf --enablerepo=\"epel\" install -y openblas-devel lapack-devel && \ + . /etc/profile.d/modules.sh && \ + module avail && module load mpi && module list && \ + cd /tmp && \ + cd arpack-ng && \ + git status && \ + git log -2 && \ + mkdir -p build && cd build && \ + cmake -DEXAMPLES=ON -DMPI=ON -DICB=ON .. && \ + make all && make test" \ + && \ + sudo docker cp -a ${TRAVIS_BUILD_DIR} mobydick:/tmp \ + && \ + sudo docker start -a mobydick + # fedora (released fedora with openmpi) + - stage: fedora + name: "Fedora latest with openmpi" + dist: bionic + script: ./scripts/travis_fedora.sh setup openmpi latest + # fedora (with gcc 10 and mpich) + - stage: fedora + name: "Fedora rawhide with mpich" + dist: bionic + script: ./scripts/travis_fedora.sh setup mpich rawhide + # osx + - stage: osx + os: osx + osx_image: xcode12 + before_install: + - brew list -1 | while read line; do brew unlink $line; done; + - brew list gcc || brew install gcc + - brew list autoconf || brew install autoconf + - brew list automake || brew install automake + - brew list mpich || brew install mpich + - brew list -1 | while read line; do brew link --overwrite $line; done; + - softwareupdate --install -a + # full build and testing with Accelerate framework (xcode provides vecLib which stands for BLAS/LAPACK) + # note: -ff2c to convert fortran code to C, -fno-second-underscore to force underscoring of external symbols to link + script: | + ./bootstrap && LIBS="-framework Accelerate" FFLAGS="-ff2c -fno-second-underscore" FCFLAGS="-ff2c -fno-second-underscore" ./configure --enable-icb --enable-mpi && make VERBOSE=1 && make check + - stage: osx + os: osx + osx_image: xcode12 + before_install: + - brew list -1 | while read line; do brew unlink $line; done; + - brew list gcc || brew install gcc + - brew list cmake || brew install cmake + - brew list openblas || brew install openblas + - brew list lapack || brew install lapack + - brew list mpich || brew install mpich + - brew list -1 | while read line; do brew link --overwrite $line; done; + # full build and testing with openblas and lapack + # note: -ff2c to convert fortran code to C, -fno-second-underscore to force underscoring of external symbols to link + script: | + mkdir -p build && cd build && FFLAGS="-ff2c -fno-second-underscore" FCFLAGS="-ff2c -fno-second-underscore" cmake -DEXAMPLES=ON -DICB=ON -DMPI=ON .. && make VERBOSE=1 && make test + - stage: osx + os: osx + osx_image: xcode11 + before_install: + - brew list -1 | while read line; do brew unlink $line; done; + - brew list arpack || brew install arpack # Test osx formula + - brew list -1 | while read line; do brew link --overwrite $line; done; + script: ls # Need fake script. + - stage: osx + os: osx + osx_image: xcode12 + before_install: + - brew list -1 | while read line; do brew unlink $line; done; + - brew list arpack || brew install arpack # Test osx formula + - brew list -1 | while read line; do brew link --overwrite $line; done; + script: ls # Need fake script. + # ubuntu_precise <=> test "older" systems, without ICB, without cmake (too old to be supported) + - stage: ubuntu_precise dist: precise script: ./bootstrap && ./configure && make VERBOSE=1 && make check && make distcheck; - - stage: precise + - stage: ubuntu_precise dist: precise script: ./bootstrap && ./configure --enable-mpi && make VERBOSE=1 && make check && make distcheck; - # trusty <=> test "older" systems, without ICB - - stage: trusty - dist: trusty - script: mkdir -p build && cd build && cmake -D EXAMPLES=ON -D MPI=OFF -D ICB=OFF .. && make VERBOSE=1 && make test && make package_source; - - stage: trusty + # ubuntu_trusty <=> test "older" systems, without ICB + - stage: ubuntu_trusty dist: trusty script: mkdir -p build && cd build && cmake -D EXAMPLES=ON -D MPI=ON -D ICB=OFF .. && make VERBOSE=1 && make test && make package_source; - - stage: trusty - dist: trusty - script: ./bootstrap && ./configure && make VERBOSE=1 && make check && make distcheck; - - stage: trusty + - stage: ubuntu_trusty dist: trusty script: ./bootstrap && ./configure --enable-mpi && make VERBOSE=1 && make check && make distcheck; - # xenial <=> test "recent" systems, with and without ICB - - stage: xenial - dist: xenial - script: mkdir -p build && cd build && cmake -D EXAMPLES=ON -D MPI=OFF -D ICB=OFF .. && make VERBOSE=1 && make test && make package_source; - - stage: xenial - dist: xenial - script: mkdir -p build && cd build && cmake -D EXAMPLES=ON -D MPI=ON -D ICB=OFF .. && make VERBOSE=1 && make test && make package_source; - - stage: xenial - dist: xenial - script: mkdir -p build && cd build && cmake -D EXAMPLES=ON -D MPI=OFF -D ICB=ON .. && make VERBOSE=1 && make test && make package_source; - - stage: xenial - dist: xenial - script: mkdir -p build && cd build && cmake -DEXAMPLES=ON -DMPI=OFF -DICBEXMM=ON .. && make VERBOSE=1 && make test && make package_source; - - stage: xenial + # ubuntu_xenial <=> test "recent" systems, with ICB + - stage: ubuntu_xenial dist: xenial script: mkdir -p build && cd build && cmake -D EXAMPLES=ON -D MPI=ON -D ICB=ON .. && make VERBOSE=1 && make test && make package_source; - - stage: xenial - dist: xenial - script: ./bootstrap && ./configure && make VERBOSE=1 && make check && make distcheck; - - stage: xenial - dist: xenial - script: ./bootstrap && ./configure --enable-mpi && make VERBOSE=1 && make check && make distcheck; - - stage: xenial - dist: xenial - script: ./bootstrap && ./configure --enable-icb && make VERBOSE=1 && make check && make distcheck; - - stage: xenial - dist: xenial - script: ./bootstrap && ./configure --enable-icb-exmm && make VERBOSE=1 && make check && make distcheck; - - stage: xenial + - stage: ubuntu_xenial dist: xenial script: ./bootstrap && ./configure --enable-mpi --enable-icb && make VERBOSE=1 && make check && make distcheck; - # xenial <=> coverage: "recent" systems with ICB + # ubuntu_bionic <=> test "recent" systems, with ICB + - stage: ubuntu_bionic + dist: bionic + script: ./bootstrap && ./configure --enable-icb --enable-icb-exmm --enable-mpi && export VERBOSE=1 && make all && make check + - stage: ubuntu_bionic + dist: bionic + before_install: + - sudo apt-get -y install python3-minimal python3-pip python3-numpy + - sudo pip3 install --system numpy + # need to build boost-python from source for python 3 (repository package is built for python 2) + - sudo apt-get -y install wget + - wget https://sourceforge.net/projects/boost/files/boost/1.67.0/boost_1_67_0.tar.gz + - tar -xf boost_1_67_0.tar.gz && cd boost_1_67_0 + - ./bootstrap.sh --with-libraries=python --with-python=/usr/bin/python3 + - sudo ./b2 install + - sudo apt-get install locate + - sudo updatedb + script: | + cd $TRAVIS_BUILD_DIR && mkdir -p build && cd build && \ + cmake -DEXAMPLES=ON -DICB=ON -DICBEXMM=ON -DMPI=ON -DPYTHON3=ON -DBOOST_PYTHON_LIBSUFFIX='36' .. && \ + export VERBOSE=1 && make all && make test + # ubuntu_eoan <=> test "recent" systems, with ICB + - stage: ubuntu_eoan + dist: bionic + script: ./scripts/travis_ubuntu.sh ubuntu :eoan + # ubuntu_focal <=> test "recent" systems, with ICB + - stage: ubuntu_focal + dist: bionic + script: ./scripts/travis_ubuntu.sh ubuntu :focal + # coverage: "recent" systems with ICB - stage: coverage - dist: xenial - script: mkdir -p build && cd build && cmake -DEXAMPLES=ON -DMPI=ON -DICBEXMM=ON -DCOVERALLS=ON .. && make && make test coveralls > /dev/null; - # xenial <=> interface64: "recent" systems with ICB + MKL + ILP64 (need debian/testing to get MKL-ILP64) - - stage: interface64 - allow_failure: + dist: bionic + script: | + mkdir -p build && cd build \ + && \ + cmake -DEXAMPLES=ON -DMPI=ON -DICB=ON -DCOVERALLS=ON .. &> cmake.log \ + && \ + tail -n 50 cmake.log \ + && \ + make all &> compil.log \ + && \ + tail -n 50 compil.log \ + && \ + make test &> test.log \ + && \ + tail -n 50 test.log \ + && \ + make coveralls &> coveralls.log \ + && \ + head -n 50 coveralls.log && tail -n 50 coveralls.log \ + && \ + head -n 50 coveralls.json && tail -n 50 coveralls.json + # debian_interface64: "recent" systems with ICB + MKL + ILP64 (need debian/testing to get MKL-ILP64) + # note: when you PR, docker-cp provides, in the container, the branch associated with the PR (not master where there's nothing new) + # 1. docker create --name mobydick IMAGE CMD <=> create a container (= instance of image) but container is NOT yet started + # 2. docker cp -a ${TRAVIS_BUILD_DIR} mobydick:/tmp <=> copy git repository (CI worker, checkout-ed on PR branch) into the container + # note: docker-cp works only if copy from/to containers (not images) + # 3. docker start -a mobydick <=> start to run the container (initialized with docker-cp) + - stage: debian_interface64 dist: xenial script: | sudo docker pull debian \ && \ - sudo docker run debian /bin/bash -c \ + sudo docker create --name mobydick debian /bin/bash -c \ "cat /etc/os-release && \ - more /etc/apt/sources.list && \ + cat /etc/apt/sources.list && \ sed -e 's/stretch/testing/' -i /etc/apt/sources.list && \ sed -e 's/main/main non-free contrib/' -i /etc/apt/sources.list && \ - more /etc/apt/sources.list && \ + sed -e '/security.debian.org/d' -i /etc/apt/sources.list && \ + cat /etc/apt/sources.list && \ export DEBIAN_FRONTEND=noninteractive && \ apt-get -y update && \ apt-get -y --allow-unauthenticated -o Dpkg::Options::=--force-confdef upgrade && \ apt-get -y --allow-unauthenticated -o Dpkg::Options::=--force-confdef dist-upgrade && \ cat /etc/os-release && \ - apt-get -y install dialog apt-utils && \ + apt-get -y install dialog && \ echo yes | apt-get -y install intel-mkl libmkl-dev && \ apt-get -y install build-essential && \ - apt-get -y install git gfortran gcc g++ openmpi-bin libopenmpi-dev automake autoconf libeigen3-dev && \ + apt-get -y install git gfortran gcc g++ openmpi-bin libopenmpi-dev automake autoconf libtool pkg-config && \ + apt-get -y install libeigen3-dev && \ cd /tmp && \ - git clone https://github.com/opencollab/arpack-ng && \ cd arpack-ng && \ - git checkout master && \ + git status && \ + git log -2 && \ sed -e 's/LOG_FLAGS = /LOG_FLAGS = --allow-run-as-root --oversubscribe /' -i PARPACK/EXAMPLES/MPI/Makefile.am && \ sed -e 's/LOG_FLAGS = /LOG_FLAGS = --allow-run-as-root --oversubscribe /' -i PARPACK/TESTS/MPI/Makefile.am && \ ./bootstrap && \ - export FFLAGS='-I/usr/include/mkl' && \ - export FCFLAGS='-I/usr/include/mkl' && \ - export LIBS='-Wl,--no-as-needed -lmkl_sequential -lmkl_core -lpthread -lm -ldl' && \ + export FFLAGS='-DMKL_ILP64 -I/usr/include/mkl' && \ + export FCFLAGS='-DMKL_ILP64 -I/usr/include/mkl' && \ + export LIBS='-Wl,--no-as-needed -L/usr/lib/x86_64-linux-gnu -lmkl_sequential -lmkl_core -lpthread -lm -ldl' && \ export INTERFACE64=1 && \ - ./configure --with-blas=mkl_gf_ilp64 --with-lapack=mkl_gf_ilp64 -enable-icb-exmm --enable-mpi \ + ./configure --with-blas=mkl_gf_ilp64 --with-lapack=mkl_gf_ilp64 --enable-mpi --enable-icb-exmm \ --disable-dependency-tracking && \ export VERBOSE=1 && \ make all && \ - make check" + make check && \ + find . -name test-suite.log | xargs tail -n 300" \ + && \ + sudo docker cp -a ${TRAVIS_BUILD_DIR} mobydick:/tmp \ + && \ + sudo docker start -a mobydick + after_failure: # show build error or test log to know what is wrong if errors occured. - if [[ -f $TRAVIS_BUILD_DIR/build/Testing/Temporary/LastTest.log ]]; then tail -n 300 $TRAVIS_BUILD_DIR/build/Testing/Temporary/LastTest.log; fi - find . -name test-suite.log | xargs tail -n 300 + - find . -name arpackmm.run.log | xargs tail -n 300 diff -Nru arpack-3.7.0/VISUAL_STUDIO/arpack-ng_exports.def arpack-3.8.0/VISUAL_STUDIO/arpack-ng_exports.def --- arpack-3.7.0/VISUAL_STUDIO/arpack-ng_exports.def 2019-01-12 15:24:12.000000000 +0000 +++ arpack-3.8.0/VISUAL_STUDIO/arpack-ng_exports.def 2020-12-07 10:40:45.000000000 +0000 @@ -5,7 +5,6 @@ cmout_ cvout_ dgetv0_ - dlaqrb_ dmout_ dnaitr_ dnapps_